{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Matterhorn.Types.RichText
( Blocks(..)
, unBlocks
, singleB
, Block(..)
, sameBlockType
, CodeBlockInfo(..)
, Inline(..)
, Inlines(..)
, unInlines
, singleI
, C.ListType(..)
, C.ListSpacing(..)
, C.EnumeratorType(..)
, C.DelimiterType(..)
, C.ColAlignment(..)
, TeamBaseURL(..)
, TeamURLName(..)
, URL(..)
, unURL
, parseMarkdown
, findUsernames
, blockGetURLs
, findVerbatimChunk
, makePermalink
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Commonmark as C
import qualified Commonmark.Extensions as C
import qualified Commonmark.Inlines as C
import qualified Commonmark.TokParsers as C
import Control.Monad.Identity
import qualified Data.Foldable as F
import Data.List ( intersperse )
import Data.Monoid (First(..))
import qualified Data.Set as S
import qualified Data.Sequence as Seq
import Data.Sequence ( (<|), viewl, viewr, ViewL((:<)), ViewR((:>)) )
import qualified Data.Text as T
import qualified Text.Parsec as P
import Network.Mattermost.Types ( PostId(..), Id(..), ServerBaseURL(..) )
import Matterhorn.Constants ( userSigilChar, normalChannelSigilChar )
data TeamURLName = TeamURLName Text
deriving (TeamURLName -> TeamURLName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamURLName -> TeamURLName -> Bool
$c/= :: TeamURLName -> TeamURLName -> Bool
== :: TeamURLName -> TeamURLName -> Bool
$c== :: TeamURLName -> TeamURLName -> Bool
Eq, Int -> TeamURLName -> ShowS
[TeamURLName] -> ShowS
TeamURLName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamURLName] -> ShowS
$cshowList :: [TeamURLName] -> ShowS
show :: TeamURLName -> String
$cshow :: TeamURLName -> String
showsPrec :: Int -> TeamURLName -> ShowS
$cshowsPrec :: Int -> TeamURLName -> ShowS
Show, Eq TeamURLName
TeamURLName -> TeamURLName -> Bool
TeamURLName -> TeamURLName -> Ordering
TeamURLName -> TeamURLName -> TeamURLName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TeamURLName -> TeamURLName -> TeamURLName
$cmin :: TeamURLName -> TeamURLName -> TeamURLName
max :: TeamURLName -> TeamURLName -> TeamURLName
$cmax :: TeamURLName -> TeamURLName -> TeamURLName
>= :: TeamURLName -> TeamURLName -> Bool
$c>= :: TeamURLName -> TeamURLName -> Bool
> :: TeamURLName -> TeamURLName -> Bool
$c> :: TeamURLName -> TeamURLName -> Bool
<= :: TeamURLName -> TeamURLName -> Bool
$c<= :: TeamURLName -> TeamURLName -> Bool
< :: TeamURLName -> TeamURLName -> Bool
$c< :: TeamURLName -> TeamURLName -> Bool
compare :: TeamURLName -> TeamURLName -> Ordering
$ccompare :: TeamURLName -> TeamURLName -> Ordering
Ord)
data TeamBaseURL = TeamBaseURL TeamURLName ServerBaseURL
deriving (TeamBaseURL -> TeamBaseURL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamBaseURL -> TeamBaseURL -> Bool
$c/= :: TeamBaseURL -> TeamBaseURL -> Bool
== :: TeamBaseURL -> TeamBaseURL -> Bool
$c== :: TeamBaseURL -> TeamBaseURL -> Bool
Eq, Int -> TeamBaseURL -> ShowS
[TeamBaseURL] -> ShowS
TeamBaseURL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamBaseURL] -> ShowS
$cshowList :: [TeamBaseURL] -> ShowS
show :: TeamBaseURL -> String
$cshow :: TeamBaseURL -> String
showsPrec :: Int -> TeamBaseURL -> ShowS
$cshowsPrec :: Int -> TeamBaseURL -> ShowS
Show)
newtype Blocks = Blocks (Seq Block)
deriving (NonEmpty Blocks -> Blocks
Blocks -> Blocks -> Blocks
forall b. Integral b => b -> Blocks -> Blocks
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Blocks -> Blocks
$cstimes :: forall b. Integral b => b -> Blocks -> Blocks
sconcat :: NonEmpty Blocks -> Blocks
$csconcat :: NonEmpty Blocks -> Blocks
<> :: Blocks -> Blocks -> Blocks
$c<> :: Blocks -> Blocks -> Blocks
Semigroup, Semigroup Blocks
Blocks
[Blocks] -> Blocks
Blocks -> Blocks -> Blocks
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Blocks] -> Blocks
$cmconcat :: [Blocks] -> Blocks
mappend :: Blocks -> Blocks -> Blocks
$cmappend :: Blocks -> Blocks -> Blocks
mempty :: Blocks
$cmempty :: Blocks
Monoid, Int -> Blocks -> ShowS
[Blocks] -> ShowS
Blocks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Blocks] -> ShowS
$cshowList :: [Blocks] -> ShowS
show :: Blocks -> String
$cshow :: Blocks -> String
showsPrec :: Int -> Blocks -> ShowS
$cshowsPrec :: Int -> Blocks -> ShowS
Show, Blocks -> Blocks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Blocks -> Blocks -> Bool
$c/= :: Blocks -> Blocks -> Bool
== :: Blocks -> Blocks -> Bool
$c== :: Blocks -> Blocks -> Bool
Eq)
unBlocks :: Blocks -> Seq Block
unBlocks :: Blocks -> Seq Block
unBlocks (Blocks Seq Block
bs) = Seq Block
bs
singleB :: Block -> Blocks
singleB :: Block -> Blocks
singleB = Seq Block -> Blocks
Blocks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton
data Block =
Para Inlines
| Int Inlines
| Blockquote Blocks
| List C.ListType C.ListSpacing (Seq Blocks)
| CodeBlock CodeBlockInfo Text
| HTMLBlock Text
| HRule
| Table [C.ColAlignment] [Inlines] [[Inlines]]
deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, Block -> Block -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq)
sameBlockType :: Block -> Block -> Bool
sameBlockType :: Block -> Block -> Bool
sameBlockType (Para {}) (Para {}) = Bool
True
sameBlockType (Header {}) (Header {}) = Bool
True
sameBlockType (Blockquote {}) (Blockquote {}) = Bool
True
sameBlockType (List {}) (List {}) = Bool
True
sameBlockType (CodeBlock {}) (CodeBlock {}) = Bool
True
sameBlockType (HTMLBlock {}) (HTMLBlock {}) = Bool
True
sameBlockType Block
_ Block
_ = Bool
False
data CodeBlockInfo =
CodeBlockInfo { CodeBlockInfo -> Maybe Text
codeBlockLanguage :: Maybe Text
, CodeBlockInfo -> Maybe Text
codeBlockInfo :: Maybe Text
}
deriving (CodeBlockInfo -> CodeBlockInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeBlockInfo -> CodeBlockInfo -> Bool
$c/= :: CodeBlockInfo -> CodeBlockInfo -> Bool
== :: CodeBlockInfo -> CodeBlockInfo -> Bool
$c== :: CodeBlockInfo -> CodeBlockInfo -> Bool
Eq, Int -> CodeBlockInfo -> ShowS
[CodeBlockInfo] -> ShowS
CodeBlockInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeBlockInfo] -> ShowS
$cshowList :: [CodeBlockInfo] -> ShowS
show :: CodeBlockInfo -> String
$cshow :: CodeBlockInfo -> String
showsPrec :: Int -> CodeBlockInfo -> ShowS
$cshowsPrec :: Int -> CodeBlockInfo -> ShowS
Show, Eq CodeBlockInfo
CodeBlockInfo -> CodeBlockInfo -> Bool
CodeBlockInfo -> CodeBlockInfo -> Ordering
CodeBlockInfo -> CodeBlockInfo -> CodeBlockInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CodeBlockInfo -> CodeBlockInfo -> CodeBlockInfo
$cmin :: CodeBlockInfo -> CodeBlockInfo -> CodeBlockInfo
max :: CodeBlockInfo -> CodeBlockInfo -> CodeBlockInfo
$cmax :: CodeBlockInfo -> CodeBlockInfo -> CodeBlockInfo
>= :: CodeBlockInfo -> CodeBlockInfo -> Bool
$c>= :: CodeBlockInfo -> CodeBlockInfo -> Bool
> :: CodeBlockInfo -> CodeBlockInfo -> Bool
$c> :: CodeBlockInfo -> CodeBlockInfo -> Bool
<= :: CodeBlockInfo -> CodeBlockInfo -> Bool
$c<= :: CodeBlockInfo -> CodeBlockInfo -> Bool
< :: CodeBlockInfo -> CodeBlockInfo -> Bool
$c< :: CodeBlockInfo -> CodeBlockInfo -> Bool
compare :: CodeBlockInfo -> CodeBlockInfo -> Ordering
$ccompare :: CodeBlockInfo -> CodeBlockInfo -> Ordering
Ord)
newtype URL = URL Text
deriving (URL -> URL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c== :: URL -> URL -> Bool
Eq, Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> String
$cshow :: URL -> String
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show, Eq URL
URL -> URL -> Bool
URL -> URL -> Ordering
URL -> URL -> URL
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: URL -> URL -> URL
$cmin :: URL -> URL -> URL
max :: URL -> URL -> URL
$cmax :: URL -> URL -> URL
>= :: URL -> URL -> Bool
$c>= :: URL -> URL -> Bool
> :: URL -> URL -> Bool
$c> :: URL -> URL -> Bool
<= :: URL -> URL -> Bool
$c<= :: URL -> URL -> Bool
< :: URL -> URL -> Bool
$c< :: URL -> URL -> Bool
compare :: URL -> URL -> Ordering
$ccompare :: URL -> URL -> Ordering
Ord)
unURL :: URL -> Text
unURL :: URL -> Text
unURL (URL Text
url) = Text
url
data Inline =
EText Text
| EEmph Inlines
| EStrikethrough Inlines
| EStrong Inlines
| ECode Inlines
| ESpace
| ESoftBreak
| ELineBreak
| ERawHtml Text
| EEditSentinel Bool
| EUser Text
| EChannel Text
| EHyperlink URL Inlines
| EImage URL Inlines
| EEmoji Text
| ENonBreaking Inlines
| EPermalink TeamURLName PostId (Maybe Inlines)
deriving (Int -> Inline -> ShowS
[Inline] -> ShowS
Inline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inline] -> ShowS
$cshowList :: [Inline] -> ShowS
show :: Inline -> String
$cshow :: Inline -> String
showsPrec :: Int -> Inline -> ShowS
$cshowsPrec :: Int -> Inline -> ShowS
Show, Inline -> Inline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inline -> Inline -> Bool
$c/= :: Inline -> Inline -> Bool
== :: Inline -> Inline -> Bool
$c== :: Inline -> Inline -> Bool
Eq, Eq Inline
Inline -> Inline -> Bool
Inline -> Inline -> Ordering
Inline -> Inline -> Inline
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Inline -> Inline -> Inline
$cmin :: Inline -> Inline -> Inline
max :: Inline -> Inline -> Inline
$cmax :: Inline -> Inline -> Inline
>= :: Inline -> Inline -> Bool
$c>= :: Inline -> Inline -> Bool
> :: Inline -> Inline -> Bool
$c> :: Inline -> Inline -> Bool
<= :: Inline -> Inline -> Bool
$c<= :: Inline -> Inline -> Bool
< :: Inline -> Inline -> Bool
$c< :: Inline -> Inline -> Bool
compare :: Inline -> Inline -> Ordering
$ccompare :: Inline -> Inline -> Ordering
Ord)
newtype Inlines = Inlines (Seq Inline)
deriving (Semigroup Inlines
Inlines
[Inlines] -> Inlines
Inlines -> Inlines -> Inlines
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Inlines] -> Inlines
$cmconcat :: [Inlines] -> Inlines
mappend :: Inlines -> Inlines -> Inlines
$cmappend :: Inlines -> Inlines -> Inlines
mempty :: Inlines
$cmempty :: Inlines
Monoid, Eq Inlines
Inlines -> Inlines -> Bool
Inlines -> Inlines -> Ordering
Inlines -> Inlines -> Inlines
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Inlines -> Inlines -> Inlines
$cmin :: Inlines -> Inlines -> Inlines
max :: Inlines -> Inlines -> Inlines
$cmax :: Inlines -> Inlines -> Inlines
>= :: Inlines -> Inlines -> Bool
$c>= :: Inlines -> Inlines -> Bool
> :: Inlines -> Inlines -> Bool
$c> :: Inlines -> Inlines -> Bool
<= :: Inlines -> Inlines -> Bool
$c<= :: Inlines -> Inlines -> Bool
< :: Inlines -> Inlines -> Bool
$c< :: Inlines -> Inlines -> Bool
compare :: Inlines -> Inlines -> Ordering
$ccompare :: Inlines -> Inlines -> Ordering
Ord, Inlines -> Inlines -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inlines -> Inlines -> Bool
$c/= :: Inlines -> Inlines -> Bool
== :: Inlines -> Inlines -> Bool
$c== :: Inlines -> Inlines -> Bool
Eq, Int -> Inlines -> ShowS
[Inlines] -> ShowS
Inlines -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inlines] -> ShowS
$cshowList :: [Inlines] -> ShowS
show :: Inlines -> String
$cshow :: Inlines -> String
showsPrec :: Int -> Inlines -> ShowS
$cshowsPrec :: Int -> Inlines -> ShowS
Show)
unInlines :: Inlines -> Seq Inline
unInlines :: Inlines -> Seq Inline
unInlines (Inlines Seq Inline
is) = Seq Inline
is
singleI :: Inline -> Inlines
singleI :: Inline -> Inlines
singleI = Seq Inline -> Inlines
Inlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton
instance Semigroup Inlines where
(Inlines Seq Inline
l) <> :: Inlines -> Inlines -> Inlines
<> (Inlines Seq Inline
r) =
Seq Inline -> Inlines
Inlines forall a b. (a -> b) -> a -> b
$ case (forall a. Seq a -> ViewR a
viewr Seq Inline
l, forall a. Seq a -> ViewL a
viewl Seq Inline
r) of
(Seq Inline
lInit :> Inline
lLast, Inline
rHead :< Seq Inline
rTail) ->
case (Inline
lLast, Inline
rHead) of
(EText Text
a, EText Text
b) ->
Seq Inline
lInit forall a. Semigroup a => a -> a -> a
<> ((Text -> Inline
EText forall a b. (a -> b) -> a -> b
$ Text
a forall a. Semigroup a => a -> a -> a
<> Text
b) forall a. a -> Seq a -> Seq a
<| Seq Inline
rTail)
(ECode Inlines
a, ECode Inlines
b) ->
Seq Inline
lInit forall a. Semigroup a => a -> a -> a
<> ((Inlines -> Inline
ECode forall a b. (a -> b) -> a -> b
$ Inlines
a forall a. Semigroup a => a -> a -> a
<> Inlines
b) forall a. a -> Seq a -> Seq a
<| Seq Inline
rTail)
(EEmph Inlines
a, EEmph Inlines
b) ->
Seq Inline
lInit forall a. Semigroup a => a -> a -> a
<> ((Inlines -> Inline
EEmph forall a b. (a -> b) -> a -> b
$ Inlines
a forall a. Semigroup a => a -> a -> a
<> Inlines
b) forall a. a -> Seq a -> Seq a
<| Seq Inline
rTail)
(EStrikethrough Inlines
a, EStrikethrough Inlines
b) ->
Seq Inline
lInit forall a. Semigroup a => a -> a -> a
<> ((Inlines -> Inline
EStrikethrough forall a b. (a -> b) -> a -> b
$ Inlines
a forall a. Semigroup a => a -> a -> a
<> Inlines
b) forall a. a -> Seq a -> Seq a
<| Seq Inline
rTail)
(EStrong Inlines
a, EStrong Inlines
b) ->
Seq Inline
lInit forall a. Semigroup a => a -> a -> a
<> ((Inlines -> Inline
EStrong forall a b. (a -> b) -> a -> b
$ Inlines
a forall a. Semigroup a => a -> a -> a
<> Inlines
b) forall a. a -> Seq a -> Seq a
<| Seq Inline
rTail)
(Inline
_, Inline
_) ->
Seq Inline
l forall a. Semigroup a => a -> a -> a
<> Seq Inline
r
(ViewR Inline
_, ViewL Inline
_) -> Seq Inline
l forall a. Semigroup a => a -> a -> a
<> Seq Inline
r
instance C.Rangeable Inlines where
ranged :: SourceRange -> Inlines -> Inlines
ranged SourceRange
_ = forall a. a -> a
id
instance C.HasAttributes Inlines where
addAttributes :: Attributes -> Inlines -> Inlines
addAttributes Attributes
_ = forall a. a -> a
id
instance C.IsInline Inlines where
lineBreak :: Inlines
lineBreak = Inline -> Inlines
singleI Inline
ELineBreak
softBreak :: Inlines
softBreak = Inline -> Inlines
singleI Inline
ESoftBreak
str :: Text -> Inlines
str Text
t = Seq Inline -> Inlines
Inlines forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= (Text -> Inline
EText Text
"")) forall a b. (a -> b) -> a -> b
$
forall a. a -> [a] -> [a]
intersperse Inline
ESpace forall a b. (a -> b) -> a -> b
$ Text -> Inline
EText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
T.splitOn Text
" " Text
t
entity :: Text -> Inlines
entity = Inline -> Inlines
singleI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
EText
escapedChar :: Char -> Inlines
escapedChar = Inline -> Inlines
singleI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
EText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton
emph :: Inlines -> Inlines
emph = Inline -> Inlines
singleI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inline
EEmph
strong :: Inlines -> Inlines
strong = Inline -> Inlines
singleI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inline
EStrong
link :: Text -> Text -> Inlines -> Inlines
link Text
url Text
_title Inlines
desc = Inline -> Inlines
singleI forall a b. (a -> b) -> a -> b
$ URL -> Inlines -> Inline
EHyperlink (Text -> URL
URL Text
url) Inlines
desc
image :: Text -> Text -> Inlines -> Inlines
image Text
url Text
_title Inlines
desc = Inline -> Inlines
singleI forall a b. (a -> b) -> a -> b
$ URL -> Inlines -> Inline
EImage (Text -> URL
URL Text
url) Inlines
desc
code :: Text -> Inlines
code Text
t = Inline -> Inlines
singleI forall a b. (a -> b) -> a -> b
$ Inlines -> Inline
ECode forall a b. (a -> b) -> a -> b
$ forall a. IsInline a => Text -> a
C.str Text
t
rawInline :: Format -> Text -> Inlines
rawInline Format
_ = Inline -> Inlines
singleI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
ERawHtml
instance C.HasStrikethrough Inlines where
strikethrough :: Inlines -> Inlines
strikethrough = Inline -> Inlines
singleI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inline
EStrikethrough
instance C.HasPipeTable Inlines Blocks where
pipeTable :: [ColAlignment] -> [Inlines] -> [[Inlines]] -> Blocks
pipeTable [ColAlignment]
a [Inlines]
h [[Inlines]]
b = Block -> Blocks
singleB forall a b. (a -> b) -> a -> b
$ [ColAlignment] -> [Inlines] -> [[Inlines]] -> Block
Table [ColAlignment]
a [Inlines]
h [[Inlines]]
b
channelSpec :: (Monad m) => C.SyntaxSpec m Inlines Blocks
channelSpec :: forall (m :: * -> *). Monad m => SyntaxSpec m Inlines Blocks
channelSpec =
forall a. Monoid a => a
mempty { syntaxInlineParsers :: [InlineParser m Inlines]
C.syntaxInlineParsers = [forall a (m :: * -> *).
(IsInline a, Monad m) =>
InlineParser m a -> InlineParser m a
C.withAttributes forall (m :: * -> *). Monad m => InlineParser m Inlines
parseChannel]
}
parseChannel :: (Monad m) => C.InlineParser m Inlines
parseChannel :: forall (m :: * -> *). Monad m => InlineParser m Inlines
parseChannel = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
normalChannelSigilChar
let chunk :: ParsecT [Tok] s (StateT Enders m) Tok
chunk = forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
C.satisfyWord (forall a b. a -> b -> a
const Bool
True) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
'_' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
'-'
[Tok]
cts <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
chunk
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inline -> Inlines
singleI forall a b. (a -> b) -> a -> b
$ Text -> Inline
EChannel forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
C.untokenize [Tok]
cts
usernameSpec :: (Monad m) => C.SyntaxSpec m Inlines Blocks
usernameSpec :: forall (m :: * -> *). Monad m => SyntaxSpec m Inlines Blocks
usernameSpec =
forall a. Monoid a => a
mempty { syntaxInlineParsers :: [InlineParser m Inlines]
C.syntaxInlineParsers = [forall a (m :: * -> *).
(IsInline a, Monad m) =>
InlineParser m a -> InlineParser m a
C.withAttributes forall (m :: * -> *). Monad m => InlineParser m Inlines
parseUsername]
}
parseUsername :: (Monad m) => C.InlineParser m Inlines
parseUsername :: forall (m :: * -> *). Monad m => InlineParser m Inlines
parseUsername = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
userSigilChar
let chunk :: ParsecT [Tok] s (StateT Enders m) Tok
chunk = forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
C.satisfyWord (forall a b. a -> b -> a
const Bool
True) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
'_' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
'-'
period :: Tok
period = case String -> Text -> [Tok]
C.tokenize String
"" Text
"." of
[Tok
p] -> Tok
p
[Tok]
_ -> forall a. HasCallStack => String -> a
error String
"BUG: parseUsername: failed to tokenize basic input"
[Tok]
uts <- forall a. a -> [a] -> [a]
intersperse Tok
period forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Tok
c <- forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
chunk
[Tok]
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
'.'
forall {s}. ParsecT [Tok] s (StateT Enders m) Tok
chunk
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tok
c forall a. a -> [a] -> [a]
: [Tok]
rest
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inline -> Inlines
singleI forall a b. (a -> b) -> a -> b
$ Text -> Inline
EUser forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
C.untokenize [Tok]
uts
emojiSpec :: (Monad m) => C.SyntaxSpec m Inlines Blocks
emojiSpec :: forall (m :: * -> *). Monad m => SyntaxSpec m Inlines Blocks
emojiSpec =
forall a. Monoid a => a
mempty { syntaxInlineParsers :: [InlineParser m Inlines]
C.syntaxInlineParsers = [forall a (m :: * -> *).
(IsInline a, Monad m) =>
InlineParser m a -> InlineParser m a
C.withAttributes forall (m :: * -> *). Monad m => InlineParser m Inlines
parseEmoji]
}
parseEmoji :: (Monad m) => C.InlineParser m Inlines
parseEmoji :: forall (m :: * -> *). Monad m => InlineParser m Inlines
parseEmoji = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
':'
[Tok]
ts <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
C.satisfyWord (forall a b. a -> b -> a
const Bool
True)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
'_'
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
'+'
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
'-'
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
C.symbol Char
':'
let kw :: Text
kw = [Tok] -> Text
C.untokenize [Tok]
ts
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inline -> Inlines
singleI forall a b. (a -> b) -> a -> b
$ Text -> Inline
EEmoji Text
kw
instance C.HasAttributes Blocks where
addAttributes :: Attributes -> Blocks -> Blocks
addAttributes Attributes
_ = forall a. a -> a
id
instance C.Rangeable Blocks where
ranged :: SourceRange -> Blocks -> Blocks
ranged SourceRange
_ = forall a. a -> a
id
instance C.IsBlock Inlines Blocks where
paragraph :: Inlines -> Blocks
paragraph = Block -> Blocks
singleB forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Block
Para
plain :: Inlines -> Blocks
plain = Block -> Blocks
singleB forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Block
Para
thematicBreak :: Blocks
thematicBreak = Block -> Blocks
singleB Block
HRule
blockQuote :: Blocks -> Blocks
blockQuote = Block -> Blocks
singleB forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Block
Blockquote
codeBlock :: Text -> Text -> Blocks
codeBlock Text
infoTxt Text
content = Block -> Blocks
singleB forall a b. (a -> b) -> a -> b
$ CodeBlockInfo -> Text -> Block
CodeBlock (Text -> CodeBlockInfo
parseCodeBlockInfo Text
infoTxt) Text
content
heading :: Int -> Inlines -> Blocks
heading Int
level Inlines
i = Block -> Blocks
singleB forall a b. (a -> b) -> a -> b
$ Int -> Inlines -> Block
Header Int
level Inlines
i
rawBlock :: Format -> Text -> Blocks
rawBlock Format
_format Text
content = Block -> Blocks
singleB forall a b. (a -> b) -> a -> b
$ CodeBlockInfo -> Text -> Block
CodeBlock (Text -> CodeBlockInfo
parseCodeBlockInfo Text
"") Text
content
list :: ListType -> ListSpacing -> [Blocks] -> Blocks
list ListType
ty ListSpacing
spacing [Blocks]
bs = Block -> Blocks
singleB forall a b. (a -> b) -> a -> b
$ ListType -> ListSpacing -> Seq Blocks -> Block
List ListType
ty ListSpacing
spacing forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList [Blocks]
bs
referenceLinkDefinition :: Text -> (Text, Text) -> Blocks
referenceLinkDefinition Text
_label (Text
_dest, Text
_title) = forall a. Monoid a => a
mempty
parseCodeBlockInfo :: Text -> CodeBlockInfo
parseCodeBlockInfo :: Text -> CodeBlockInfo
parseCodeBlockInfo Text
t = Maybe Text -> Maybe Text -> CodeBlockInfo
CodeBlockInfo Maybe Text
lang Maybe Text
info
where
ws :: [Text]
ws = Text -> [Text]
T.words Text
t
(Maybe Text
lang, Maybe Text
info) = case [Text]
ws of
[Text
l, Text
i] -> (forall a. a -> Maybe a
Just Text
l, forall a. a -> Maybe a
Just Text
i)
[Text
l] -> (forall a. a -> Maybe a
Just Text
l, forall a. Maybe a
Nothing)
[Text]
_ -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
parseMarkdown :: Maybe TeamBaseURL
-> T.Text
-> Blocks
parseMarkdown :: Maybe TeamBaseURL -> Text -> Blocks
parseMarkdown Maybe TeamBaseURL
mBaseUrl Text
t =
let customSyntax :: SyntaxSpec Identity Inlines Blocks
customSyntax = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [SyntaxSpec Identity Inlines Blocks]
markdownExtensions forall a. Semigroup a => a -> a -> a
<> [forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il) =>
SyntaxSpec m il bl
C.defaultSyntaxSpec]
markdownExtensions :: [SyntaxSpec Identity Inlines Blocks]
markdownExtensions =
[ forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il) =>
SyntaxSpec m il bl
C.autolinkSpec
, forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasStrikethrough il) =>
SyntaxSpec m il bl
C.strikethroughSpec
, forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasPipeTable il bl) =>
SyntaxSpec m il bl
C.pipeTableSpec
, forall (m :: * -> *). Monad m => SyntaxSpec m Inlines Blocks
usernameSpec
, forall (m :: * -> *). Monad m => SyntaxSpec m Inlines Blocks
channelSpec
, forall (m :: * -> *). Monad m => SyntaxSpec m Inlines Blocks
emojiSpec
]
in case forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il) =>
SyntaxSpec m il bl -> String -> Text -> m (Either ParseError bl)
C.commonmarkWith SyntaxSpec Identity Inlines Blocks
customSyntax String
"-" Text
t of
Left ParseError
_ -> forall a. Monoid a => a
mempty
Right Blocks
bs -> case Maybe TeamBaseURL
mBaseUrl of
Maybe TeamBaseURL
Nothing -> Blocks
bs
Just TeamBaseURL
baseUrl -> TeamBaseURL -> Blocks -> Blocks
rewriteBlocksPermalinks TeamBaseURL
baseUrl Blocks
bs
makePermalink :: TeamBaseURL -> PostId -> Text
makePermalink :: TeamBaseURL -> PostId -> Text
makePermalink (TeamBaseURL (TeamURLName Text
tName) (ServerBaseURL Text
baseUrl)) PostId
pId =
Text
baseUrl forall a. Semigroup a => a -> a -> a
<> Text
tName forall a. Semigroup a => a -> a -> a
<> Text
"/pl/" forall a. Semigroup a => a -> a -> a
<> Id -> Text
unId (PostId -> Id
unPI PostId
pId)
getPermalink :: TeamBaseURL -> Text -> Maybe (TeamURLName, PostId)
getPermalink :: TeamBaseURL -> Text -> Maybe (TeamURLName, PostId)
getPermalink (TeamBaseURL TeamURLName
tName (ServerBaseURL Text
baseUrl)) Text
url =
let newBaseUrl :: Text
newBaseUrl = if Text
"/" Text -> Text -> Bool
`T.isSuffixOf` Text
baseUrl
then Text
baseUrl
else Text
baseUrl forall a. Semigroup a => a -> a -> a
<> Text
"/"
in if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
newBaseUrl Text -> Text -> Bool
`T.isPrefixOf` Text
url
then forall a. Maybe a
Nothing
else let rest :: Text
rest = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
newBaseUrl) Text
url
(Text
tName', Text
rawPIdStr) = Text -> Text -> (Text, Text)
T.breakOn Text
"/pl/" Text
rest
pIdStr :: Text
pIdStr = Int -> Text -> Text
T.drop Int
4 Text
rawPIdStr
in if TeamURLName
tName forall a. Eq a => a -> a -> Bool
== Text -> TeamURLName
TeamURLName Text
tName' Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
pIdStr)
then forall a. a -> Maybe a
Just (TeamURLName
tName, Id -> PostId
PI forall a b. (a -> b) -> a -> b
$ Text -> Id
Id Text
pIdStr)
else forall a. Maybe a
Nothing
rewriteBlocksPermalinks :: TeamBaseURL -> Blocks -> Blocks
rewriteBlocksPermalinks :: TeamBaseURL -> Blocks -> Blocks
rewriteBlocksPermalinks TeamBaseURL
u (Blocks Seq Block
bs) = Seq Block -> Blocks
Blocks forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Block -> Block
rewriteBlockPermalinks TeamBaseURL
u forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Block
bs
rewriteBlockPermalinks :: TeamBaseURL -> Block -> Block
rewriteBlockPermalinks :: TeamBaseURL -> Block -> Block
rewriteBlockPermalinks TeamBaseURL
u (Table [ColAlignment]
a [Inlines]
h [[Inlines]]
b) = [ColAlignment] -> [Inlines] -> [[Inlines]] -> Block
Table [ColAlignment]
a (TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inlines]
h)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u)) [[Inlines]]
b)
rewriteBlockPermalinks TeamBaseURL
u (Para Inlines
s) = Inlines -> Block
Para forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u Inlines
s
rewriteBlockPermalinks TeamBaseURL
u (Header Int
i Inlines
s) = Int -> Inlines -> Block
Header Int
i forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u Inlines
s
rewriteBlockPermalinks TeamBaseURL
u (Blockquote Blocks
bs) = Blocks -> Block
Blockquote forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Blocks -> Blocks
rewriteBlocksPermalinks TeamBaseURL
u Blocks
bs
rewriteBlockPermalinks TeamBaseURL
u (List ListType
ty ListSpacing
spacing Seq Blocks
bss) = ListType -> ListSpacing -> Seq Blocks -> Block
List ListType
ty ListSpacing
spacing forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Blocks -> Blocks
rewriteBlocksPermalinks TeamBaseURL
u forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Blocks
bss
rewriteBlockPermalinks TeamBaseURL
_ b :: Block
b@(CodeBlock {}) = Block
b
rewriteBlockPermalinks TeamBaseURL
_ b :: Block
b@(HTMLBlock {}) = Block
b
rewriteBlockPermalinks TeamBaseURL
_ b :: Block
b@Block
HRule = Block
b
rewriteInlinePermalinks :: TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks :: TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u (Inlines Seq Inline
is) = Seq Inline -> Inlines
Inlines forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Inline -> Inline
rewriteInlinePermalink TeamBaseURL
u forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Inline
is
rewriteInlinePermalink :: TeamBaseURL -> Inline -> Inline
rewriteInlinePermalink :: TeamBaseURL -> Inline -> Inline
rewriteInlinePermalink TeamBaseURL
u i :: Inline
i@(EHyperlink URL
url Inlines
label) =
case TeamBaseURL -> Text -> Maybe (TeamURLName, PostId)
getPermalink TeamBaseURL
u (URL -> Text
unURL URL
url) of
Maybe (TeamURLName, PostId)
Nothing -> Inline
i
Just (TeamURLName
tName, PostId
pId) ->
let newLabel :: Maybe Inlines
newLabel = if Inlines
label forall a. Eq a => a -> a -> Bool
== Seq Inline -> Inlines
Inlines (forall a. [a] -> Seq a
Seq.fromList [Text -> Inline
EText forall a b. (a -> b) -> a -> b
$ URL -> Text
unURL URL
url])
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just Inlines
label
in TeamURLName -> PostId -> Maybe Inlines -> Inline
EPermalink TeamURLName
tName PostId
pId Maybe Inlines
newLabel
rewriteInlinePermalink TeamBaseURL
u (EEmph Inlines
s) = Inlines -> Inline
EEmph forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u Inlines
s
rewriteInlinePermalink TeamBaseURL
u (ECode Inlines
s) = Inlines -> Inline
ECode forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u Inlines
s
rewriteInlinePermalink TeamBaseURL
u (EStrikethrough Inlines
s) = Inlines -> Inline
EStrikethrough forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u Inlines
s
rewriteInlinePermalink TeamBaseURL
u (EStrong Inlines
s) = Inlines -> Inline
EStrong forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u Inlines
s
rewriteInlinePermalink TeamBaseURL
u (ENonBreaking Inlines
s) = Inlines -> Inline
ENonBreaking forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> Inlines -> Inlines
rewriteInlinePermalinks TeamBaseURL
u Inlines
s
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@(EText {}) = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@Inline
ESpace = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@Inline
ESoftBreak = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@Inline
ELineBreak = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@(EEditSentinel {}) = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@(ERawHtml {}) = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@(EEmoji {}) = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@(EUser {}) = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@(EChannel {}) = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@(EImage {}) = Inline
i
rewriteInlinePermalink TeamBaseURL
_ i :: Inline
i@(EPermalink {}) = Inline
i
findUsernames :: Blocks -> S.Set T.Text
findUsernames :: Blocks -> Set Text
findUsernames (Blocks Seq Block
bs) = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> Set Text
blockFindUsernames Seq Block
bs
blockFindUsernames :: Block -> S.Set T.Text
blockFindUsernames :: Block -> Set Text
blockFindUsernames (Para Inlines
is) =
[Inline] -> Set Text
inlineFindUsernames forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines Inlines
is
blockFindUsernames (Header Int
_ Inlines
is) =
[Inline] -> Set Text
inlineFindUsernames forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines Inlines
is
blockFindUsernames (Blockquote Blocks
bs) =
Blocks -> Set Text
findUsernames Blocks
bs
blockFindUsernames (Table [ColAlignment]
_ [Inlines]
header [[Inlines]]
rows) =
let cellFindUsernames :: Inlines -> Set Text
cellFindUsernames = [Inline] -> Set Text
inlineFindUsernames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Seq Inline
unInlines
in forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall a b. (a -> b) -> a -> b
$
((Inlines -> Set Text
cellFindUsernames forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inlines]
header) forall a. Semigroup a => a -> a -> a
<>
(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Inlines -> Set Text
cellFindUsernames) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Inlines]]
rows))
blockFindUsernames (List ListType
_ ListSpacing
_ Seq Blocks
bs) =
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ Blocks -> Set Text
findUsernames forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Blocks
bs
blockFindUsernames Block
HRule =
forall a. Monoid a => a
mempty
blockFindUsernames (HTMLBlock {}) =
forall a. Monoid a => a
mempty
blockFindUsernames (CodeBlock {}) =
forall a. Monoid a => a
mempty
inlineFindUsernames :: [Inline] -> S.Set T.Text
inlineFindUsernames :: [Inline] -> Set Text
inlineFindUsernames [] = forall a. Monoid a => a
mempty
inlineFindUsernames (Inline
i : [Inline]
is) =
case Inline
i of
EUser Text
u -> forall a. Ord a => a -> Set a -> Set a
S.insert Text
u forall a b. (a -> b) -> a -> b
$ [Inline] -> Set Text
inlineFindUsernames [Inline]
is
Inline
_ -> [Inline] -> Set Text
inlineFindUsernames [Inline]
is
blockGetURLs :: Block -> [(Either (TeamURLName, PostId) URL, Maybe Inlines)]
blockGetURLs :: Block -> [(Either (TeamURLName, PostId) URL, Maybe Inlines)]
blockGetURLs (Para Inlines
is) =
forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ Inline -> Maybe (Either (TeamURLName, PostId) URL, Maybe Inlines)
elementGetURL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines Inlines
is)
blockGetURLs (Header Int
_ Inlines
is) =
forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ Inline -> Maybe (Either (TeamURLName, PostId) URL, Maybe Inlines)
elementGetURL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines Inlines
is)
blockGetURLs (Blockquote Blocks
bs) =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Block -> [(Either (TeamURLName, PostId) URL, Maybe Inlines)]
blockGetURLs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Blocks -> Seq Block
unBlocks Blocks
bs)
blockGetURLs (List ListType
_ ListSpacing
_ Seq Blocks
bss) =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> [(Either (TeamURLName, PostId) URL, Maybe Inlines)]
blockGetURLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Seq Block
unBlocks) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Blocks
bss
blockGetURLs (Table [ColAlignment]
_ [Inlines]
header [[Inlines]]
rows) =
let cellFindURLs :: Inlines -> [(Either (TeamURLName, PostId) URL, Maybe Inlines)]
cellFindURLs = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Inline -> Maybe (Either (TeamURLName, PostId) URL, Maybe Inlines)
elementGetURL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Seq Inline
unInlines
in (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inlines -> [(Either (TeamURLName, PostId) URL, Maybe Inlines)]
cellFindURLs [Inlines]
header) forall a. Semigroup a => a -> a -> a
<>
(forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inlines -> [(Either (TeamURLName, PostId) URL, Maybe Inlines)]
cellFindURLs) [[Inlines]]
rows)
blockGetURLs Block
HRule =
forall a. Monoid a => a
mempty
blockGetURLs (HTMLBlock {}) =
forall a. Monoid a => a
mempty
blockGetURLs (CodeBlock {}) =
forall a. Monoid a => a
mempty
elementGetURL :: Inline -> Maybe (Either (TeamURLName, PostId) URL, Maybe Inlines)
elementGetURL :: Inline -> Maybe (Either (TeamURLName, PostId) URL, Maybe Inlines)
elementGetURL (EHyperlink URL
url Inlines
label) =
forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right URL
url, forall a. a -> Maybe a
Just Inlines
label)
elementGetURL (EImage URL
url Inlines
label) =
forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right URL
url, forall a. a -> Maybe a
Just Inlines
label)
elementGetURL (EPermalink TeamURLName
tName PostId
pId Maybe Inlines
label) =
forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (TeamURLName
tName, PostId
pId), Maybe Inlines
label)
elementGetURL Inline
_ =
forall a. Maybe a
Nothing
findVerbatimChunk :: Blocks -> Maybe Text
findVerbatimChunk :: Blocks -> Maybe Text
findVerbatimChunk (Blocks Seq Block
bs) = forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Block -> First Text
go Seq Block
bs
where go :: Block -> First Text
go (CodeBlock CodeBlockInfo
_ Text
t) = forall a. Maybe a -> First a
First (forall a. a -> Maybe a
Just Text
t)
go Block
_ = forall a. Maybe a -> First a
First forall a. Maybe a
Nothing