Scylla/src/Scylla/Views.elm

module Scylla.Views exposing (..)
import Scylla.Model exposing (..)
import Scylla.Sync exposing (..)
import Scylla.Route exposing (..)
import Scylla.Fnv as Fnv
import Scylla.Messages exposing (..)
import Scylla.Login exposing (Username)
import Scylla.UserData exposing (UserData)
import Scylla.Http exposing (fullMediaUrl)
import Scylla.Api exposing (ApiUrl)
import Html.Parser
import Html.Parser.Util
import Svg
import Svg.Attributes
import Url.Builder
import Json.Decode as Decode
import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, h3, table, td, tr, img, textarea, video, source, p)
import Html.Attributes exposing (type_, placeholder, value, href, class, style, src, id, rows, controls, src, classList)
import Html.Events exposing (onInput, onClick, preventDefaultOn)
import Html.Lazy exposing (lazy6)
import Dict exposing (Dict)
import Tuple

maybeHtml : List (Maybe (Html Msg)) -> List (Html Msg)
maybeHtml = List.filterMap (\i -> i)

contentRepositoryDownloadUrl : ApiUrl -> String -> String
contentRepositoryDownloadUrl apiUrl s =
    let
        lastIndex = Maybe.withDefault 6 <| List.head <| List.reverse <| String.indexes "/" s
        authority = String.slice 6 lastIndex s
        content = String.dropLeft (lastIndex + 1) s
    in
        (fullMediaUrl apiUrl) ++ "/download/" ++ authority ++ "/" ++ content


stringColor : String -> String
stringColor s = 
    let
        hue = String.fromFloat <| (toFloat (Fnv.hash s)) / 4294967296 * 360
    in
        "hsl(" ++ hue ++ ", 82%, 71%)"

viewFull : Model -> List (Html Msg)
viewFull model = 
    let
        room r = Maybe.map (\jr -> (r, jr))
            <| Maybe.andThen (Dict.get r)
            <| Maybe.andThen .join
            <| model.sync.rooms
        core = case model.route of
            Login -> loginView model 
            Base -> baseView model Nothing
            Room r -> baseView model <| room r
            _ -> div [] []
        errorList = errorsView model.errors
    in
        [ errorList ] ++ [ core ] 

errorsView : List String -> Html Msg
errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView

errorView : Int -> String -> Html Msg
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]

baseView : Model -> Maybe (RoomId, JoinedRoom) -> Html Msg
baseView m jr = 
    let
        roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr
        reconnect = reconnectView m
    in
        div [ class "base-wrapper" ] <| maybeHtml
            [ Just <| roomListView m
            , roomView
            , reconnect
            ]

reconnectView : Model -> Maybe (Html Msg)
reconnectView m = if m.connected
    then Nothing
    else Just <| div [ class "reconnect-wrapper", onClick AttemptReconnect ] [ iconView "zap", text "Disconnected. Click here to reconnect." ]

roomListView : Model -> Html Msg
roomListView m =
    let
        rooms = Maybe.withDefault (Dict.empty)
            <| Maybe.andThen .join
            <| m.sync.rooms
        groups = roomGroups
            <| Dict.toList rooms
        homeserverList = div [ class "homeservers-list" ]
            <| List.map (\(k, v) -> homeserverView m k v)
            <| Dict.toList groups
    in
        div [ class "rooms-wrapper" ]
            [ h2 [] [ text "Rooms" ]
            , input
                [ class "room-search"
                , type_ "text"
                , placeholder "Search chats..."
                , onInput UpdateSearchText 
                , value m.searchText
                ] []
            , homeserverList
            ]

roomGroups : List (String, JoinedRoom) -> Dict String (List (String, JoinedRoom))
roomGroups jrs = groupBy (homeserver << Tuple.first) jrs

homeserverView : Model -> String -> List (String, JoinedRoom) -> Html Msg
homeserverView m hs rs =
    let
        roomList = div [ class "rooms-list" ]
            <| List.map (\(rid, r) -> roomListElementView m rid r)
            <| List.sortBy (\(rid, r) -> roomDisplayName m.roomNames rid) rs
    in
        div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]

roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
roomListElementView m rid jr =
    let
        name = roomDisplayName m.roomNames rid
        isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
        isCurrentRoom = case currentRoomId m of
            Nothing -> False
            Just cr -> cr == rid
    in
        div [ classList
                [ ("room-link-wrapper", True)
                , ("active", isCurrentRoom)
                , ("hidden", not isVisible)
                ]
            ]
            <| roomNotificationCountView jr.unreadNotifications ++
                [ a [ href <| roomUrl rid ] [ text name ] ]

roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg)
roomNotificationCountView ns =
    let
        wrap b = span
            [ classList
                [ ("notification-count", True)
                , ("bright", b)
                ]
            ]
        getCount f = Maybe.withDefault 0 << Maybe.andThen f
    in
        case (getCount .notificationCount ns, getCount .highlightCount ns) of
            (0, 0) -> []
            (i, 0) -> [ wrap False [ iconView "bell", text <| String.fromInt i ] ]
            (i, j) -> [ wrap True [ iconView "alert-circle", text <| String.fromInt i ] ] 

loginView : Model -> Html Msg
loginView m = div [ class "login-wrapper" ]
    [ h2 [] [ text "Log In" ]
    , input [ type_ "text", placeholder "Username", value m.loginUsername, onInput ChangeLoginUsername] []
    , input [ type_ "password", placeholder "Password", value m.loginPassword, onInput ChangeLoginPassword ] []
    , input [ type_ "text", placeholder "Homeserver URL", value m.apiUrl, onInput ChangeApiUrl ] []
    , button [ onClick AttemptLogin ] [ text "Log In" ]
    ]

joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
joinedRoomView m roomId jr =
    let
        typing = List.map (displayName m.userData) <| roomTypingUsers jr
        typingText = String.join ", " typing
        typingSuffix = case List.length typing of
            0 -> ""
            1 -> " is typing..."
            _ -> " are typing..."
        typingWrapper = div [ class "typing-wrapper" ] [ text <| typingText ++ typingSuffix ] 
        messageInput = div [ class "message-wrapper" ]
            [ textarea
                [ rows 1
                , onInput <| ChangeRoomText roomId
                , onEnterKey <| SendRoomText roomId
                , placeholder "Type your message here..."
                , value <| Maybe.withDefault "" <| Dict.get roomId m.roomText
                ]  []
            , button [ onClick <| SendFiles roomId ] [ iconView "file" ]
            , button [ onClick <| SendImages roomId ] [ iconView "image" ]
            , button [ onClick <| SendRoomText roomId ] [ iconView "send" ]
            ]
    in
        div [ class "room-wrapper" ]
            [ h2 [] [ text <| roomDisplayName m.roomNames roomId ]
            , lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
            , messageInput
            , typingWrapper
            ]

lazyMessagesView : Dict String UserData -> RoomId -> JoinedRoom -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
lazyMessagesView ud rid jr au lu snd =
    let
        roomReceived = receivedMessagesRoom 
            <| Maybe.withDefault []
            <| Maybe.andThen .events jr.timeline
        roomSending = sendingMessagesRoom rid snd
        renderedMessages = List.map (userMessagesView ud au)
            <| mergeMessages lu
            <| roomReceived ++ roomSending
    in
        messagesWrapperView rid renderedMessages

onEnterKey : Msg -> Attribute Msg
onEnterKey msg =
    let
        eventDecoder = Decode.map2 (\l r -> (l, r)) (Decode.field "keyCode" Decode.int) (Decode.field "shiftKey" Decode.bool)
        msgFor (code, shift) = if code == 13 && not shift then Decode.succeed msg else Decode.fail "Not ENTER"
        pairTrue v = (v, True)
        decoder = Decode.map pairTrue <| Decode.andThen msgFor <| eventDecoder
    in
        preventDefaultOn "keydown" decoder

iconView : String -> Html Msg
iconView name =
    let
        url = Url.Builder.absolute [ "static", "svg", "feather-sprite.svg" ] [] 
    in
        Svg.svg
            [ Svg.Attributes.class "feather-icon"
            ] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]

messagesWrapperView : RoomId -> List (Html Msg) -> Html Msg
messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrapper" ]
    [ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ]
    , table [ class "messages-table" ] es
    ]

senderView : Dict String UserData -> Username -> Html Msg
senderView ud s =
    span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName ud s ]

userMessagesView : Dict String UserData -> ApiUrl -> (Username, List Message) -> Html Msg
userMessagesView ud apiUrl (u, ms) = 
    let
        wrap h = div [ class "message" ] [ h ]
    in
        tr []
            [ td [] [ senderView ud u ]
            , td [] <| List.map wrap <| List.filterMap (messageView ud apiUrl) ms
            ]

messageView : Dict String UserData -> ApiUrl -> Message -> Maybe (Html Msg)
messageView ud apiUrl msg = case msg of
    Sending t -> Just <| sendingMessageView t
    Received re -> roomEventView ud apiUrl re

sendingMessageView : SendingMessage -> Html Msg
sendingMessageView msg = case msg.body of
    TextMessage t -> span [ class "sending"] [ text t ]

roomEventView : Dict String UserData -> ApiUrl -> RoomEvent -> Maybe (Html Msg)
roomEventView ud apiUrl re =
    let
        msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
    in
        case msgtype of
            Ok "m.text" -> roomEventTextView re
            Ok "m.notice" -> roomEventNoticeView re
            Ok "m.emote" -> roomEventEmoteView ud re
            Ok "m.image" -> roomEventImageView apiUrl re
            Ok "m.file" -> roomEventFileView apiUrl re
            Ok "m.video" -> roomEventVideoView apiUrl re
            _ -> Nothing

roomEventFormattedContent : RoomEvent -> Maybe (List (Html Msg))
roomEventFormattedContent re = Maybe.map Html.Parser.Util.toVirtualDom
    <| Maybe.andThen (Result.toMaybe << Html.Parser.run )
    <| Result.toMaybe
    <| Decode.decodeValue (Decode.field "formatted_body" Decode.string) re.content

roomEventContent : (List (Html Msg) -> Html Msg) -> RoomEvent -> Maybe (Html Msg)
roomEventContent f re =
    let
        body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
        customHtml = roomEventFormattedContent re
    in
        case customHtml of
            Just c -> Just <| f c
            Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body

roomEventEmoteView : Dict String UserData -> RoomEvent -> Maybe (Html Msg)
roomEventEmoteView ud re =
    let
        emoteText = "* " ++ displayName ud re.sender ++ " "
    in
        roomEventContent (\cs -> span [] (text emoteText :: cs)) re

roomEventNoticeView : RoomEvent -> Maybe (Html Msg)
roomEventNoticeView = roomEventContent (span [ class "message-notice" ])

roomEventTextView : RoomEvent -> Maybe (Html Msg)
roomEventTextView = roomEventContent (span [])

roomEventImageView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
roomEventImageView apiUrl re =
    let
        body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
    in
        Maybe.map (\s -> img [ class "message-image", src s ] [])
            <| Maybe.map (contentRepositoryDownloadUrl apiUrl)
            <| Result.toMaybe body

roomEventFileView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
roomEventFileView apiUrl re =
    let
        decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string)
        fileData = Decode.decodeValue decoder re.content
    in
        Maybe.map (\(url, name) -> a [ href url, class "file-wrapper" ] [ iconView "file", text name ])
        <| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl apiUrl url, name))
        <| Result.toMaybe fileData

roomEventVideoView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
roomEventVideoView apiUrl re =
    let
        decoder = Decode.map2 (\l r -> (l, r))
            (Decode.field "url" Decode.string)
            (Decode.field "info" <| Decode.field "mimetype" Decode.string)
        videoData = Decode.decodeValue decoder re.content
    in
        Maybe.map (\(url, t) -> video [ controls True ] [ source [ src url, type_ t ] [] ])
        <| Maybe.map (\(url, type_) -> (contentRepositoryDownloadUrl apiUrl url, type_))
        <| Result.toMaybe videoData