{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module Text.Jira.Parser.Inline
( inline
, anchor
, autolink
, citation
, colorInline
, dash
, emoji
, entity
, image
, linebreak
, link
, monospaced
, specialChar
, str
, styled
, whitespace
, specialChars
) where
import Control.Monad (guard, void)
import Data.Char (isAlphaNum, isAscii, isPunctuation, isSpace, ord)
#if !MIN_VERSION_base(4,13,0)
import Data.Monoid ((<>), All (..))
#else
import Data.Monoid (All (..))
#endif
import Data.Text (append, pack)
import Text.Jira.Markup
import Text.Jira.Parser.Core
import Text.Jira.Parser.Shared
import Text.Parsec
inline :: JiraParser Inline
inline :: JiraParser Inline
inline = forall a. Show a => JiraParser a -> JiraParser ()
notFollowedBy' forall {u}. ParsecT Text u Identity [Char]
blockEnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ JiraParser Inline
whitespace
, JiraParser Inline
emoji
, JiraParser Inline
dash
, JiraParser Inline
autolink
, JiraParser Inline
str
, JiraParser Inline
linebreak
, JiraParser Inline
link
, JiraParser Inline
image
, JiraParser Inline
styled
, JiraParser Inline
colorInline
, JiraParser Inline
monospaced
, JiraParser Inline
anchor
, JiraParser Inline
citation
, JiraParser Inline
entity
, JiraParser Inline
specialChar
] forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"inline"
where
blockEnd :: ParsecT Text u Identity [Char]
blockEnd = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (forall a b. (a -> b) -> [a] -> [b]
map forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [[Char]]
blockNames) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
specialChars :: String
specialChars :: [Char]
specialChars = [Char]
"_+-*^~|[]{}(?!&\\:;"
linebreak :: JiraParser Inline
linebreak :: JiraParser Inline
linebreak = (forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"linebreak") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserState -> Bool
stateInMarkup forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Show a => JiraParser a -> JiraParser ()
notFollowedBy' JiraParser ()
endOfPara
, forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\\\" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Show a => JiraParser a -> JiraParser ()
notFollowedBy' (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\')
]
JiraParser ()
updateLastSpcPos
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
Linebreak
whitespace :: JiraParser Inline
whitespace :: JiraParser Inline
whitespace = Inline
Space forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* JiraParser ()
updateLastSpcPos
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"whitespace"
str :: JiraParser Inline
str :: JiraParser Inline
str = Text -> Inline
Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text ParserState Identity [Char]
alphaNums forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity [Char]
otherNonSpecialChars)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"string"
where
nonStrChars :: [Char]
nonStrChars = [Char]
" \n" forall a. [a] -> [a] -> [a]
++ [Char]
specialChars
alphaNums :: ParsecT Text ParserState Identity [Char]
alphaNums = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* JiraParser ()
updateLastStrPos
otherNonSpecialChars :: ParsecT Text u Identity [Char]
otherNonSpecialChars = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ \Char
c ->
Bool -> Bool
not (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
nonStrChars)
entity :: JiraParser Inline
entity :: JiraParser Inline
entity = Text -> Inline
Entity forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall {u}. ParsecT Text u Identity [Char]
numerical forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity [Char]
named) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';')
where
numerical :: ParsecT Text u Identity [Char]
numerical = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
named :: ParsecT Text u Identity [Char]
named = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
emoji :: JiraParser Inline
emoji :: JiraParser Inline
emoji = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Icon -> Inline
Emoji forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall u. Parsec Text u Icon
icon forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"emoji")
dash :: JiraParser Inline
dash :: JiraParser Inline
dash = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JiraParser Bool
notAfterString
[Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"--"
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Text -> Inline
Str Text
"—" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
, forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Inline
Str Text
"–")
] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
specialChar :: JiraParser Inline
specialChar :: JiraParser Inline
specialChar = Char -> Inline
SpecialChar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {u}. ParsecT Text u Identity Char
backslash forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity Char
escapedChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text ParserState Identity Char
plainSpecialChar)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"special char"
where
backslash :: ParsecT Text u Identity Char
backslash = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall u. Parsec Text u Icon
icon' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum))
escapedChar :: ParsecT Text u Identity Char
escapedChar = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isPunctuation)
plainSpecialChar :: ParsecT Text ParserState Identity Char
plainSpecialChar = do
Char -> All
inTablePred <- do
Bool
b <- ParserState -> Bool
stateInTable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
b then Bool -> All
All forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
/= Char
'|') else forall a. Monoid a => a
mempty
Char -> All
inLinkPred <- do
Bool
b <- ParserState -> Bool
stateInLink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
b then Bool -> All
All forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Char]
"]^|\n" :: String)) else forall a. Monoid a => a
mempty
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (All -> Bool
getAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> All
inTablePred forall a. Semigroup a => a -> a -> a
<> Char -> All
inLinkPred)) [Char]
specialChars
anchor :: JiraParser Inline
anchor :: JiraParser Inline
anchor = Text -> Inline
Anchor forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
' ')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{anchor:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n" forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')
image :: JiraParser Inline
image :: JiraParser Inline
image = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
URL
src <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!'
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> URL
URL forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\r\t\n|]!"))
[Parameter]
params <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall {u}. ParsecT Text u Identity [Parameter]
thumbnail forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity Parameter
imgParams forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy` JiraParser ()
comma))
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Parameter] -> URL -> Inline
Image [Parameter]
params URL
src
where
thumbnail :: ParsecT Text u Identity [Parameter]
thumbnail = [Text -> Text -> Parameter
Parameter Text
"thumbnail" Text
""] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"thumbnail")
imgParams :: ParsecT Text u Identity Parameter
imgParams = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> Text -> Parameter
Parameter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Text
key forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {u}. ParsecT Text u Identity Text
value))
key :: ParsecT Text u Identity Text
key = [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
",\"'\t\n\r |{}=!")
value :: ParsecT Text u Identity Text
value = [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall {u}. ParsecT Text u Identity [Char]
quotedValue forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity [Char]
unquotedValue)
comma :: JiraParser ()
comma = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> JiraParser ()
skipSpaces
quotedValue :: ParsecT Text u Identity [Char]
quotedValue = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n\r") (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')
unquotedValue :: ParsecT Text u Identity [Char]
unquotedValue = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
",\"'\n\r|{}=!")
link :: JiraParser Inline
link :: JiraParser Inline
link = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserState -> Bool
stateInLink forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall a.
(Bool -> ParserState -> ParserState)
-> JiraParser a -> JiraParser a
withStateFlag (\Bool
b ParserState
st -> ParserState
st { stateInLink :: Bool
stateInLink = Bool
b }) forall a b. (a -> b) -> a -> b
$ do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
([Inline]
alias, Char
sep) <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([], Char
'|') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many JiraParser Inline
inline forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"^|"
(LinkType
linkType, URL
linkURL) <-
if Char
sep forall a. Eq a => a -> a -> Bool
== Char
'|'
then (LinkType
Email,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity URL
email forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(LinkType
External,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity URL
anchorLink forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(LinkType
User,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity URL
userLink forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
ParsecT Text ParserState Identity (LinkType, URL)
externalLink
else (LinkType
Attachment,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> URL
URL forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\t\r\f\n]|:;/\\")
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LinkType -> [Inline] -> URL -> Inline
Link LinkType
linkType [Inline]
alias URL
linkURL
autolink :: JiraParser Inline
autolink :: JiraParser Inline
autolink = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserState -> Bool
stateInLink forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
URL -> Inline
AutoLink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity URL
email' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT Text ParserState Identity URL
url Bool
True) forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"email or other URL"
where email' :: ParsecT Text ParserState Identity URL
email' = (\(URL Text
e) -> Text -> URL
URL (Text
"mailto:" forall a. Semigroup a => a -> a -> a
<> Text
e)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity URL
email
url :: Bool -> JiraParser URL
url :: Bool -> ParsecT Text ParserState Identity URL
url Bool
isAutoLink = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
let urlChar' :: ParsecT Text ParserState Identity Char
urlChar' = if Bool
isAutoLink then ParsecT Text ParserState Identity Char
urlPathChar else ParsecT Text ParserState Identity Char
urlChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
Text
urlScheme <- forall {u}. ParsecT Text u Identity Text
scheme
Text
sep <- [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"://"
Text
rest <- [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text ParserState Identity Char
urlChar'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> URL
URL (Text
urlScheme Text -> Text -> Text
`append` Text
sep Text -> Text -> Text
`append` Text
rest)
where
scheme :: ParsecT Text u Identity Text
scheme = do
Char
first <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
case Char
first of
Char
'f' -> (Text
"file" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
isAutoLink) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"ile")) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(Text
"ftp" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"tp")
Char
'h' -> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"ttp" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"http" (Text
"https" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
's')
Char
'i' -> Text
"irc" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"rc"
Char
'n' -> (Text
"nntp" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"ntp") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"news" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"ews")
Char
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"not looking at a known scheme"
email :: JiraParser URL
email :: ParsecT Text ParserState Identity URL
email = Text -> URL
URL forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"mailto:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text ParserState Identity Char
urlChar)
anchorLink :: JiraParser URL
anchorLink :: ParsecT Text ParserState Identity URL
anchorLink = Text -> URL
URL forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text ParserState Identity Char
urlChar)
userLink :: JiraParser URL
userLink :: ParsecT Text ParserState Identity URL
userLink = Text -> URL
URL forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'~' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"|]\n\r"))
externalLink :: JiraParser (LinkType, URL)
externalLink :: ParsecT Text ParserState Identity (LinkType, URL)
externalLink = do
URL
url' <- Bool -> ParsecT Text ParserState Identity URL
url Bool
False
Maybe LinkType
mSmartType <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity LinkType
smartLinkType)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe LinkType
mSmartType of
Maybe LinkType
Nothing -> (LinkType
External, URL
url')
Just LinkType
st -> (LinkType
st, URL
url')
smartLinkType :: JiraParser LinkType
smartLinkType :: ParsecT Text ParserState Identity LinkType
smartLinkType = forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"smart-" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ LinkType
SmartLink forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"link"
, LinkType
SmartCard forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"card"
]
urlChar :: JiraParser Char
urlChar :: ParsecT Text ParserState Identity Char
urlChar = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ \case
Char
']' -> Bool
False
Char
'|' -> Bool
False
Char
x -> Char -> Int
ord Char
x forall a. Ord a => a -> a -> Bool
> Int
32 Bool -> Bool -> Bool
&& Char -> Int
ord Char
x forall a. Ord a => a -> a -> Bool
<= Int
126
urlPathChar :: JiraParser Char
urlPathChar :: ParsecT Text ParserState Identity Char
urlPathChar = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ \case
Char
'!' -> Bool
True
Char
'#' -> Bool
True
Char
'$' -> Bool
True
Char
'%' -> Bool
True
Char
'&' -> Bool
True
Char
'\''-> Bool
True
Char
'(' -> Bool
True
Char
')' -> Bool
True
Char
'*' -> Bool
True
Char
'+' -> Bool
True
Char
',' -> Bool
True
Char
'-' -> Bool
True
Char
'.' -> Bool
True
Char
'/' -> Bool
True
Char
':' -> Bool
True
Char
';' -> Bool
True
Char
'=' -> Bool
True
Char
'?' -> Bool
True
Char
'@' -> Bool
True
Char
'\\'-> Bool
True
Char
'_' -> Bool
True
Char
'~' -> Bool
True
Char
x -> Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
x
colorInline :: JiraParser Inline
colorInline :: JiraParser Inline
colorInline = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
[Char]
name <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{color:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {u}. ParsecT Text u Identity [Char]
colorName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
[Inline]
content <- JiraParser Inline
inline forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{color}")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ColorName -> [Inline] -> Inline
ColorInline (Text -> ColorName
ColorName forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack [Char]
name) [Inline]
content
styled :: JiraParser Inline
styled :: JiraParser Inline
styled = (JiraParser Inline
simpleStyled forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JiraParser Inline
forceStyled) forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"styled text"
where
simpleStyled :: JiraParser Inline
simpleStyled = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
Char
styleChar <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"-_+*~^"
[Inline]
content <- forall a. JiraParser a -> JiraParser a
noNewlines forall a b. (a -> b) -> a -> b
$ Char
styleChar forall a. Char -> JiraParser a -> JiraParser [a]
`delimitingMany` JiraParser Inline
inline
let style :: InlineStyle
style = Char -> InlineStyle
delimiterStyle Char
styleChar
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InlineStyle -> [Inline] -> Inline
Styled InlineStyle
style [Inline]
content
forceStyled :: JiraParser Inline
forceStyled = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
Char
styleChar <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"-_+*~^" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
let closing :: ParsecT Text u Identity [Char]
closing = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char
'{', Char
styleChar, Char
'}']
let style :: InlineStyle
style = Char -> InlineStyle
delimiterStyle Char
styleChar
[Inline]
content <- forall a. JiraParser a -> JiraParser a
noNewlines forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill JiraParser Inline
inline forall {u}. ParsecT Text u Identity [Char]
closing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InlineStyle -> [Inline] -> Inline
Styled InlineStyle
style [Inline]
content
noNewlines :: JiraParser a -> JiraParser a
noNewlines :: forall a. JiraParser a -> JiraParser a
noNewlines = forall a.
(Bool -> ParserState -> ParserState)
-> JiraParser a -> JiraParser a
withStateFlag (\Bool
b ParserState
st -> ParserState
st { stateInMarkup :: Bool
stateInMarkup = Bool
b })
delimiterStyle :: Char -> InlineStyle
delimiterStyle :: Char -> InlineStyle
delimiterStyle = \case
Char
'*' -> InlineStyle
Strong
Char
'+' -> InlineStyle
Insert
Char
'-' -> InlineStyle
Strikeout
Char
'^' -> InlineStyle
Superscript
Char
'_' -> InlineStyle
Emphasis
Char
'~' -> InlineStyle
Subscript
Char
c -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Unknown delimiter character: " forall a. [a] -> [a] -> [a]
++ [Char
c])
monospaced :: JiraParser Inline
monospaced :: JiraParser Inline
monospaced = [Inline] -> Inline
Monospaced
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall closing opening a.
Show closing =>
JiraParser opening
-> JiraParser closing -> JiraParser a -> JiraParser [a]
enclosed (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"{{") (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"}}") JiraParser Inline
inline
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"monospaced"
citation :: JiraParser Inline
citation :: JiraParser Inline
citation = [Inline] -> Inline
Citation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall closing opening a.
Show closing =>
JiraParser opening
-> JiraParser closing -> JiraParser a -> JiraParser [a]
enclosed (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"??") (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"??") JiraParser Inline
inline
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"citation"
delimitingMany :: Char -> JiraParser a -> JiraParser [a]
delimitingMany :: forall a. Char -> JiraParser a -> JiraParser [a]
delimitingMany Char
c = forall closing opening a.
Show closing =>
JiraParser opening
-> JiraParser closing -> JiraParser a -> JiraParser [a]
enclosed (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c) (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c)
enclosed :: Show closing
=> JiraParser opening -> JiraParser closing
-> JiraParser a
-> JiraParser [a]
enclosed :: forall closing opening a.
Show closing =>
JiraParser opening
-> JiraParser closing -> JiraParser a -> JiraParser [a]
enclosed JiraParser opening
opening JiraParser closing
closing JiraParser a
parser = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JiraParser Bool
notAfterString
JiraParser opening
opening forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall end a.
Show end =>
JiraParser a -> JiraParser end -> JiraParser [a]
many1Till JiraParser a
parser JiraParser closing
closing'
where
closing' :: JiraParser closing
closing' = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JiraParser Bool
afterSpace
JiraParser closing
closing forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall {u}. ParsecT Text u Identity ()
wordBoundary
wordBoundary :: ParsecT Text u Identity ()
wordBoundary = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof