{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Commonmark.Extensions.Autolink
  ( autolinkSpec )
where
import Commonmark.Types
import Commonmark.Tokens
import Commonmark.Syntax
import Commonmark.Inlines
import Commonmark.TokParsers
import Control.Monad (guard, void)
import Text.Parsec
import Data.Text (Text)

autolinkSpec :: (Monad m, IsBlock il bl, IsInline il)
             => SyntaxSpec m il bl
autolinkSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il) =>
SyntaxSpec m il bl
autolinkSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxInlineParsers = [parseAutolink]
  }

parseAutolink :: (Monad m, IsInline a) => InlineParser m a
parseAutolink :: forall (m :: * -> *) a. (Monad m, IsInline a) => InlineParser m a
parseAutolink = do
  ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok)
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok ((Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok)
-> (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall a b. (a -> b) -> a -> b
$ \Tok
t ->
    case Tok -> TokType
tokType Tok
t of
      TokType
WordChars -> Bool
True
      Symbol Char
c  -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
      TokType
_         -> Bool
False
  (Text
prefix, [Tok]
linktext) <- ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) (Text, [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw (ParsecT [Tok] (IPState m) (StateT Enders m) Text
 -> ParsecT [Tok] (IPState m) (StateT Enders m) (Text, [Tok]))
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) (Text, [Tok])
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall (m :: * -> *). Monad m => InlineParser m Text
wwwAutolink ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall (m :: * -> *). Monad m => InlineParser m Text
urlAutolink ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall (m :: * -> *). Monad m => InlineParser m Text
emailAutolink
  a -> InlineParser m a
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$! Text -> Text -> a -> a
forall a. IsInline a => Text -> Text -> a -> a
link (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
linktext) Text
"" (Text -> a
forall a. IsInline a => Text -> a
str (Text -> a) -> ([Tok] -> Text) -> [Tok] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> a) -> [Tok] -> a
forall a b. (a -> b) -> a -> b
$ [Tok]
linktext)

wwwAutolink :: Monad m => InlineParser m Text
wwwAutolink :: forall (m :: * -> *). Monad m => InlineParser m Text
wwwAutolink = ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) Text
 -> ParsecT [Tok] (IPState m) (StateT Enders m) Text)
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall a b. (a -> b) -> a -> b
$ do
  ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok)
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"www")
  InlineParser m ()
forall (m :: * -> *). Monad m => InlineParser m ()
validDomain
  Int -> InlineParser m ()
forall (m :: * -> *). Monad m => Int -> InlineParser m ()
linkPath Int
0
  Text -> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"http://"

validDomain :: Monad m => InlineParser m ()
validDomain :: forall (m :: * -> *). Monad m => InlineParser m ()
validDomain = do
  let domainPart :: ParsecT [Tok] u (StateT Enders m) ()
domainPart = do
        [Tok]
ds <- ParsecT [Tok] u (StateT Enders m) Tok
-> ParsecT [Tok] u (StateT Enders m) [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Tok] u (StateT Enders m) Tok
 -> ParsecT [Tok] u (StateT Enders m) [Tok])
-> ParsecT [Tok] u (StateT Enders m) Tok
-> ParsecT [Tok] u (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] u (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
WordChars)
                           ParsecT [Tok] u (StateT Enders m) Tok
-> ParsecT [Tok] u (StateT Enders m) Tok
-> ParsecT [Tok] u (StateT Enders m) Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] u (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
                           ParsecT [Tok] u (StateT Enders m) Tok
-> ParsecT [Tok] u (StateT Enders m) Tok
-> ParsecT [Tok] u (StateT Enders m) Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] u (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'_'
        Bool -> ParsecT [Tok] u (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] u (StateT Enders m) ())
-> Bool -> ParsecT [Tok] u (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ case [Tok] -> [Tok]
forall a. [a] -> [a]
reverse [Tok]
ds of
                     (Tok TokType
WordChars SourcePos
_ Text
_ : [Tok]
_) -> Bool
True
                     [Tok]
_ -> Bool
False
  InlineParser m ()
forall {u}. ParsecT [Tok] u (StateT Enders m) ()
domainPart
  InlineParser m () -> InlineParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (InlineParser m () -> InlineParser m ())
-> InlineParser m () -> InlineParser m ()
forall a b. (a -> b) -> a -> b
$ InlineParser m () -> InlineParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.' ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> InlineParser m () -> InlineParser m ()
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InlineParser m ()
forall {u}. ParsecT [Tok] u (StateT Enders m) ()
domainPart)

linkPath :: Monad m => Int -> InlineParser m ()
linkPath :: forall (m :: * -> *). Monad m => Int -> InlineParser m ()
linkPath Int
openParens =
      ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'&' ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
           ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy
             (ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((Text -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True) ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
';' ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => InlineParser m ()
linkEnd)) ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
           Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> InlineParser m ()
linkPath Int
openParens)
  ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => InlineParser m ()
pathPunctuation ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> InlineParser m ()
linkPath Int
openParens)
  ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'(' ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> InlineParser m ()
linkPath (Int
openParens Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
openParens Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
')' ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> InlineParser m ()
linkPath (Int
openParens Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  -- the following clause is needed to implement the GFM spec, which allows
  -- unbalanced ) except at link end. However, leaving this in causes
  -- problematic interaction with explicit link syntax in certain odd cases (see #147).
  -- <|> (notFollowedBy linkEnd *> symbol ')' *> linkPath (openParens - 1))
  ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\Tok
t -> case Tok -> TokType
tokType Tok
t of
                            TokType
LineEnd -> Bool
False
                            TokType
Spaces -> Bool
False
                            Symbol Char
c -> Bool -> Bool
not (Char -> Bool
isTrailingPunctuation Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')')
                            TokType
_ -> Bool
True) ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> InlineParser m ()
linkPath Int
openParens)
  ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

linkEnd :: Monad m => InlineParser m ()
linkEnd :: forall (m :: * -> *). Monad m => InlineParser m ()
linkEnd = ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) ()
 -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => InlineParser m ()
trailingPunctuation ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)

trailingPunctuation :: Monad m => InlineParser m ()
trailingPunctuation :: forall (m :: * -> *). Monad m => InlineParser m ()
trailingPunctuation = ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$
  (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\Tok
t -> case Tok -> TokType
tokType Tok
t of
                           Symbol Char
c -> Char -> Bool
isTrailingPunctuation Char
c
                           TokType
_ -> Bool
False)

isTrailingPunctuation :: Char -> Bool
isTrailingPunctuation :: Char -> Bool
isTrailingPunctuation =
  (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'!', Char
'"', Char
'\'', Char
')', Char
'*', Char
',', Char
'.', Char
':', Char
';', Char
'?', Char
'_', Char
'~', Char
'<'])

pathPunctuation :: Monad m => InlineParser m ()
pathPunctuation :: forall (m :: * -> *). Monad m => InlineParser m ()
pathPunctuation = ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) ()
 -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ do
  (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\Tok
t -> case Tok -> TokType
tokType Tok
t of
                       Symbol Char
c -> Char -> Bool
isTrailingPunctuation Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<'
                       TokType
_        -> Bool
False)
  ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\Tok
t -> case Tok -> TokType
tokType Tok
t of
                                        TokType
WordChars -> Bool
True
                                        TokType
_ -> Bool
False))

urlAutolink :: Monad m => InlineParser m Text
urlAutolink :: forall (m :: * -> *). Monad m => InlineParser m Text
urlAutolink = ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) Text
 -> ParsecT [Tok] (IPState m) (StateT Enders m) Text)
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall a b. (a -> b) -> a -> b
$ do
  (Text -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"http", Text
"https", Text
"ftp"])
  Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':'
  Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/'
  Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/'
  InlineParser m ()
forall (m :: * -> *). Monad m => InlineParser m ()
validDomain
  Int -> InlineParser m ()
forall (m :: * -> *). Monad m => Int -> InlineParser m ()
linkPath Int
0
  Text -> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""

emailAutolink :: Monad m => InlineParser m Text
emailAutolink :: forall (m :: * -> *). Monad m => InlineParser m Text
emailAutolink = ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) Text
 -> ParsecT [Tok] (IPState m) (StateT Enders m) Text)
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
-> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall a b. (a -> b) -> a -> b
$ do
  let emailNameTok :: Tok -> Bool
emailNameTok (Tok TokType
WordChars SourcePos
_ Text
_) = Bool
True
      emailNameTok (Tok (Symbol Char
c) SourcePos
_ Text
_) =
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
      emailNameTok Tok
_ = Bool
False
  ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
emailNameTok
  Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'@'
  ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => InlineParser m ()
validDomain
  Text -> ParsecT [Tok] (IPState m) (StateT Enders m) Text
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"mailto:"