tooty/src/View/Formatter.elm

module View.Formatter exposing (formatContent, textContent)

import Dict
import Html exposing (..)
import Html.Attributes exposing (..)
import HtmlParser
import HtmlParser.Util as ParseUtil
import Http
import Mastodon.Model exposing (..)
import String.Extra exposing (replace, rightOf)
import Types exposing (..)
import View.Events exposing (..)
import Regex
import Json.Encode


formatContent : String -> List Mention -> List Emoji -> List (Html Msg)
formatContent content mentions emojis =
    content
        |> replace " ?" " ?"
        |> replace " !" " !"
        |> replace " :" " :"
        |> HtmlParser.parse
        |> toVirtualDom mentions emojis


textContent : String -> String
textContent html =
    html |> HtmlParser.parse |> ParseUtil.textContent


{-| Converts nodes to virtual dom nodes.
-}
toVirtualDom : List Mention -> List Emoji-> List HtmlParser.Node -> List (Html Msg)
toVirtualDom mentions emojis nodes =
    List.map (toVirtualDomEach mentions emojis) nodes


replaceHref : String -> List ( String, String ) -> List (Attribute Msg)
replaceHref newHref attrs =
    attrs
        |> List.map toAttribute
        |> List.append [ onClickWithPreventAndStop <| Navigate newHref ]


createLinkNode : List ( String, String ) -> List HtmlParser.Node -> List Mention -> Html Msg
createLinkNode attrs children mentions =
    case (getMentionForLink attrs mentions) of
        Just mention ->
            Html.node "a"
                (replaceHref ("#account/" ++ mention.id) attrs)
                (toVirtualDom mentions [] children)

        Nothing ->
            case getHashtagForLink attrs of
                Just hashtag ->
                    Html.node "a"
                        (replaceHref ("#hashtag/" ++ hashtag) attrs)
                        (toVirtualDom mentions [] children)

                Nothing ->
                    Html.node "a"
                        ((List.map toAttribute attrs)
                            ++ [ onClickWithStop NoOp, target "_blank" ]
                        )
                        (toVirtualDom mentions [] children)


getHrefLink : List ( String, String ) -> Maybe String
getHrefLink attrs =
    attrs
        |> List.filter (\( name, _ ) -> name == "href")
        |> List.map (\( _, value ) -> value)
        |> List.head


getHashtagForLink : List ( String, String ) -> Maybe String
getHashtagForLink attrs =
    let
        hashtag =
            attrs
                |> Dict.fromList
                |> Dict.get "href"
                |> Maybe.withDefault ""
                |> rightOf "/tags/"
                |> Http.decodeUri
                |> Maybe.withDefault ""
    in
        if hashtag /= "" then
            Just hashtag
        else
            Nothing


getMentionForLink : List ( String, String ) -> List Mention -> Maybe Mention
getMentionForLink attrs mentions =
    case getHrefLink attrs of
        Just href ->
            mentions
                |> List.filter (\m -> m.url == href)
                |> List.head

        Nothing ->
            Nothing


toVirtualDomEach : List Mention -> List Emoji -> HtmlParser.Node -> Html Msg
toVirtualDomEach mentions emoji node =
    case node of
        HtmlParser.Element "a" attrs children ->
            createLinkNode attrs children mentions

        HtmlParser.Element name attrs children ->
            Html.node name (List.map toAttribute attrs) (toVirtualDom mentions emoji children)

        HtmlParser.Text s ->
            handleEmoji s emoji

        HtmlParser.Comment _ ->
            text ""


-- VERY janky.
handleEmoji : String -> List Emoji -> Html Msg
handleEmoji s emojis =
  span [ property "innerHTML" <| Json.Encode.string <| Regex.replace Regex.All shortcodeRegex (\{match} -> displayEmoji match emojis) <| simpleSanitize <| s ] []


simpleSanitize : String -> String
simpleSanitize content =
    content
        |> replace "<" "&lt;"
        |> replace ">" "&gt;"


displayEmoji : String -> List Emoji -> String
displayEmoji s emojis =
    case (lookupEmoji (String.slice 1 -1 s) emojis) of
        Just emoji ->
            "<img src=\""++emoji.url++"\" title=\""++s++"\" class=\"emoji-custom\">"

        Nothing ->
            s


lookupEmoji : String -> List Emoji -> Maybe Emoji
lookupEmoji shortcode emojis =
    emojis
        |> List.filter (\m -> m.shortcode == shortcode)
        |> List.head


shortcodeRegex : Regex.Regex
shortcodeRegex =
  Regex.regex ":[^:]*(?:::]*)*:"


toAttribute : ( String, String ) -> Attribute msg
toAttribute ( name, value ) =
    attribute name value