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 "<" "<" |> replace ">" ">" displayEmoji : String -> List Emoji -> String displayEmoji s emojis = case (lookupEmoji (String.slice 1 -1 s) emojis) of Just emoji -> "" 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