{-# 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 -> Int -> InlineParser m ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath Int
0 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 -> Int -> InlineParser m ()
linkPath :: forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath Int
openParens Int
openBrackets = ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> 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 ()
optional (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 TokType
tt SourcePos
_ Text
_ <- 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
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
   case TokType
tt of
     Symbol Char
'&' -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> 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 ()
optional (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 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 -> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath Int
openParens Int
openBrackets)
     Symbol Char
'(' -> 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 -> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath (Int
openParens Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
openBrackets
     Symbol Char
')' -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> 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 ()
optional (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
$ 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 -> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath (Int
openParens Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
openBrackets
     Symbol Char
'[' -> 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 -> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath Int
openParens (Int
openBrackets Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
     Symbol Char
']' -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> 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 ()
optional (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
$ 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 -> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath Int
openParens (Int
openBrackets Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
     Symbol Char
'<' -> () -> 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 ()
     Symbol Char
c | Char -> Bool
isTrailingPunctuation Char
c -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> 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 ()
optional (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 a
try (do 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
forall (m :: * -> *). Monad m => InlineParser m Tok
trailingPunctuation
                 SourcePos
pos <- ParsecT [Tok] (IPState m) (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                 Int -> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath Int
openParens Int
openBrackets
                 SourcePos
pos' <- ParsecT [Tok] (IPState m) (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                 Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SourcePos
pos' SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
> SourcePos
pos)) 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 -> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath Int
openParens Int
openBrackets
     TokType
LineEnd -> () -> 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 ()
     TokType
Spaces -> () -> 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 ()
     TokType
_ -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok 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 -> Int -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath Int
openParens Int
openBrackets

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) Tok
-> 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) Tok
forall (m :: * -> *). Monad m => InlineParser m Tok
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 Tok
trailingPunctuation :: forall (m :: * -> *). Monad m => InlineParser m Tok
trailingPunctuation =
  (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
'<'])

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 -> Int -> InlineParser m ()
forall (m :: * -> *). Monad m => Int -> Int -> InlineParser m ()
linkPath Int
0 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:"