Parse GFM Extended autolinks

spec-results.json

@@ -31,11 +31,8 @@
       601,
       602,
       603,
-      604,
       605,
-      606,
-      607,
-      608
+      606
     ],
     "Backslash escapes": [
       298,
@@ -558,11 +555,8 @@
       601,
       602,
       603,
-      604,
       605,
-      606,
-      607,
-      608
+      606
     ],
     "Backslash escapes": [
       298,
@@ -1052,6 +1046,18 @@
       28,
       29
     ],
+    "[extension] Autolinks": [
+      621,
+      622,
+      623,
+      624,
+      625,
+      626,
+      627,
+      629,
+      630,
+      631
+    ],
     "[extension] Strikethrough": [
       492
     ],

src/Markdown/InlineParser.elm

@@ -145,6 +145,8 @@ type Meaning
     | EmphasisToken Char { leftFringeRank : Int, rightFringeRank : Int }
     | SoftLineBreakToken
     | HardLineBreakToken
+    | ExtendedAutolink
+    | EmailAutolink
 
 
 findToken : (Token -> Bool) -> List Token -> Maybe ( Token, List Token, List Token )
@@ -250,6 +252,8 @@ tokenize rawText =
         |> mergeByIndex (findHardBreakTokens rawText)
         |> mergeByIndex (findAngleBracketLTokens rawText)
         |> mergeByIndex (findAngleBracketRTokens rawText)
+        |> mergeByIndex (findExtendedAutolinkTokens rawText)
+        |> mergeByIndex (findEmailAutolinkTokens rawText)
 
 
 {-| Merges two sorted sequences into a sorted sequence
@@ -685,6 +689,104 @@ regMatchToLinkImageCloseToken regMatch =
 
 
 
+-- GFM Auto Link Tokens
+
+
+findExtendedAutolinkTokens : String -> List Token
+findExtendedAutolinkTokens str =
+    Regex.find extendedAutoLinkRegex str
+        |> List.filterMap regMatchToExtendedAutolinkToken
+
+
+extendedAutoLinkRegex : Regex
+extendedAutoLinkRegex =
+    -- what if we do this without the negative lookbehind and just make it a sub match?
+    Regex.fromString "(?<=^|\\s|\\*|_|~|\\()(?:(?:https?://)|(?:www\\.))[a-z0-9A-Z_-]+(?:\\.[a-z0-9A-Z_-]+)*(?:/([^\\s<]*))?"
+        |> Maybe.withDefault Regex.never
+
+
+extendedAutoLinkTrailingPunctuationRegex : Regex
+extendedAutoLinkTrailingPunctuationRegex =
+    --should this use the isPunctuation helper?
+    Regex.fromString "[?!\\.,:*_~]+$"
+        |> Maybe.withDefault Regex.never
+
+
+extendedAutoLinkTrailingEntityReferenceRegex : Regex
+extendedAutoLinkTrailingEntityReferenceRegex =
+    Regex.fromString "(&[a-zA-Z0-9]+;)+$"
+        |> Maybe.withDefault Regex.never
+
+
+regMatchToExtendedAutolinkToken : Regex.Match -> Maybe Token
+regMatchToExtendedAutolinkToken regMatch =
+    let
+        lengthOfTrailingPunctuation =
+            regMatch.match
+                |> Regex.find extendedAutoLinkTrailingPunctuationRegex
+                |> List.head
+                |> Maybe.map (.match >> String.length)
+                |> Maybe.withDefault 0
+
+        lengthOfUnmatchedParenthesis =
+            if String.endsWith ")" regMatch.match then
+                Basics.max 0 (List.length (String.indexes ")" regMatch.match) - List.length (String.indexes "(" regMatch.match))
+
+            else
+                0
+
+        lengthOfTrailingEntityReferences =
+            regMatch.match
+                |> Regex.find extendedAutoLinkTrailingEntityReferenceRegex
+                |> List.head
+                |> Maybe.map (.match >> String.length)
+                |> Maybe.withDefault 0
+    in
+    Just
+        { index = regMatch.index
+        , length = String.length regMatch.match - lengthOfTrailingPunctuation - lengthOfUnmatchedParenthesis - lengthOfTrailingEntityReferences
+        , meaning = ExtendedAutolink
+        }
+
+
+
+-- GFM Auto Link Tokens
+
+
+findEmailAutolinkTokens : String -> List Token
+findEmailAutolinkTokens str =
+    Regex.find emailAutoLinkRegex str
+        |> List.filterMap regMatchToEmailAutolinkToken
+
+
+emailAutoLinkRegex : Regex
+emailAutoLinkRegex =
+    Regex.fromString "(?<=^|\\s|\\*|_|~|\\()[a-zA-Z0-9\\._+-]+@[a-zA-Z0-9_-]+((\\.[a-zA-Z0-9_-]+)+)"
+        |> Maybe.withDefault Regex.never
+
+
+regMatchToEmailAutolinkToken : Regex.Match -> Maybe Token
+regMatchToEmailAutolinkToken regMatch =
+    let
+        lastCharacter =
+            regMatch.match
+                |> String.right 1
+                |> String.uncons
+                |> Maybe.map Tuple.first
+    in
+    case Maybe.map Char.isAlphaNum lastCharacter of
+        Just True ->
+            Just
+                { index = regMatch.index
+                , length = String.length regMatch.match
+                , meaning = EmailAutolink
+                }
+
+        _ ->
+            Nothing
+
+
+
 -- Angle Brackets Tokens
 
 
@@ -1142,6 +1244,68 @@ autolinkToMatch (Match match) =
         Result.Err (Match match)
 
 
+extendedAutolinkToMatch : String -> Token -> Maybe Match
+extendedAutolinkToMatch rawText token =
+    let
+        start =
+            token.index
+
+        end =
+            token.index + token.length
+
+        text =
+            String.slice token.index end rawText
+
+        url =
+            withProtocol text
+    in
+    if Regex.contains urlRegex url then
+        { type_ = AutolinkType ( text, encodeUrl url )
+        , start = start
+        , end = end
+        , textStart = 0
+        , textEnd = 0
+        , text = ""
+        , matches = []
+        }
+            |> Match
+            |> Just
+
+    else
+        Nothing
+
+
+emailAutolinkToMatch : String -> Token -> Maybe Match
+emailAutolinkToMatch rawText token =
+    let
+        start =
+            token.index
+
+        end =
+            token.index + token.length
+
+        text =
+            String.slice token.index end rawText
+
+        url =
+            "mailto:" ++ text
+    in
+    if Regex.contains urlRegex url then
+        { type_ = AutolinkType ( text, encodeUrl url )
+        , start = start
+        , end = end
+        , textStart = 0
+        , textEnd = 0
+        , text = ""
+        , matches = []
+        }
+            |> Match
+            |> Just
+
+    else
+        Nothing
+
+
 
 -- From http://spec.commonmark.org/dingus/commonmark.js
 
@@ -1254,6 +1418,14 @@ htmlElementTTM remaining tokens matches references rawText =
 
                                 Just ( closeToken, innerTokens, newTail ) ->
                                     let
+                                        withoutInnerLinksIfAnchor =
+                                            case htmlModel of
+                                                HtmlParser.Element "a" _ _ ->
+                                                    List.filter (isExtendedAutoLink >> not) innerTokens
+
+                                                _ ->
+                                                    innerTokens
+
                                         newMatch =
                                             tokenPairToMatch
                                                 references
@@ -1262,7 +1434,7 @@ htmlElementTTM remaining tokens matches references rawText =
                                                 (HtmlType htmlModel)
                                                 token
                                                 closeToken
-                                                innerTokens
+                                                withoutInnerLinksIfAnchor
                                     in
                                     htmlElementTTM newTail tokens (newMatch :: matches) references rawText
 
@@ -1299,12 +1471,17 @@ voidHtmlTags =
 
 isCloseToken : HtmlModel -> Token -> Bool
 isCloseToken htmlModel token =
-    --case token.meaning of
-    --    HtmlToken False htmlModel_ ->
-    --        htmlModel.tag == htmlModel_.tag
-    --
-    --    _ ->
-    False
+    case token.meaning of
+        HtmlToken NotOpening htmlModel_ ->
+            case ( htmlModel, htmlModel_ ) of
+                ( HtmlParser.Element firstTag _ _, HtmlParser.Element secondTag _ _ ) ->
+                    firstTag == secondTag
+
+                _ ->
+                    False
+
+        _ ->
+            False
 
 
 
@@ -1316,7 +1493,7 @@ linkImageTypeTTM : List Token -> List Token -> List Match -> References -> Strin
 linkImageTypeTTM remaining tokens matches references rawText =
     case remaining of
         [] ->
-            emphasisTTM (List.reverse tokens) [] matches references rawText
+            extendedAutolinkTTM (List.reverse tokens) [] matches references rawText
 
         token :: tokensTail ->
             case token.meaning of
@@ -1607,13 +1784,22 @@ refRegexToMatch matchModel references maybeRegexMatch =
                         _ ->
                             LinkType (prepareUrlAndTitle rawUrl maybeTitle)
             in
-            Just (
-                Match
+            Just
+                (Match
                     { matchModel
                         | type_ = type_
                         , end = matchModel.end + regexMatchLength
                     }
-                    )
+                )
+
+
+withProtocol : String -> String
+withProtocol url =
+    if String.startsWith "http" url then
+        url
+
+    else
+        "http://" ++ url
 
 
 encodeUrl : String -> String
@@ -1638,6 +1824,67 @@ decodeUrlRegex =
 
 
 
+-- ExtendedAutolink Tokens To Matches
+
+
+isExtendedAutoLink : Token -> Bool
+isExtendedAutoLink token =
+    case token.meaning of
+        ExtendedAutolink ->
+            True
+
+        EmailAutolink ->
+            True
+
+        _ ->
+            False
+
+
+extendedAutolinkTTM : List Token -> List Token -> List Match -> References -> String -> List Match
+extendedAutolinkTTM remaining tokens matches references rawText =
+    case remaining of
+        [] ->
+            emailAutolinkTTM (List.reverse tokens) [] matches references rawText
+
+        token :: tokensTail ->
+            case token.meaning of
+                ExtendedAutolink ->
+                    case extendedAutolinkToMatch rawText token of
+                        Just match ->
+                            extendedAutolinkTTM tokensTail tokens (match :: matches) references rawText
+
+                        Nothing ->
+                            extendedAutolinkTTM tokensTail (token :: tokens) matches references rawText
+
+                _ ->
+                    extendedAutolinkTTM tokensTail (token :: tokens) matches references rawText
+
+
+
+-- EmailAutolink Tokens To Matches
+
+
+emailAutolinkTTM : List Token -> List Token -> List Match -> References -> String -> List Match
+emailAutolinkTTM remaining tokens matches references rawText =
+    case remaining of
+        [] ->
+            emphasisTTM (List.reverse tokens) [] matches references rawText
+
+        token :: tokensTail ->
+            case token.meaning of
+                EmailAutolink ->
+                    case emailAutolinkToMatch rawText token of
+                        Just match ->
+                            emailAutolinkTTM tokensTail tokens (match :: matches) references rawText
+
+                        Nothing ->
+                            emailAutolinkTTM tokensTail (token :: tokens) matches references rawText
+
+                _ ->
+                    emailAutolinkTTM tokensTail (token :: tokens) matches references rawText
+
+
+
 -- EmphasisType Tokens To Matches