Closes #44: Autocomplete usernames. (#107)

* Get @mention in model

* Add autocomplete logic

* Get accounts to autocomplete from the server

* Add autocomplete css

* Check if we should show menu on account search

* Add keyboard events

* Update status with completed username

* Trigger autocomplete when getting accounts back

* Highlight choices on hover

* Put focus on textarea after updating it

* Fix clear draft

* Hit the server only on non empty query

* Lazzzzzzzzzzzzzzzzyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy

* Add missing lazy

* Add keyboard subscriptions

* Add images and display name

* Better menu visibility handling

* Add lazy to notifications

* Js formatting.

* Improve styles.

* Add unique keys to costly lists.

* Fix tests.

* Coding style nits.

* Use the encodeUrl helper in ApiUrl.

* Nanonit.

* Improve autocomplete box styling.

* CamelCase draft record

* Move all autocomplete stuff to Draft

* Send status to ports with the reply prefix.

* Clear draft after posting a status.

* Move ports setStatus call to a dedicated Command helper.

* Naming.

* Fix navigation with arrow keys in textarea

* Always autoselect the first item of the menu

elm-package.json

@@ -20,7 +20,8 @@
         "evancz/url-parser": "2.0.1 <= v < 3.0.0",
         "jinjor/elm-html-parser": "1.1.5 <= v < 2.0.0",
         "lukewestby/elm-http-builder": "5.1.0 <= v < 6.0.0",
-        "rluiten/elm-date-extra": "8.5.0 <= v < 9.0.0"
+        "rluiten/elm-date-extra": "8.5.0 <= v < 9.0.0",
+        "thebritican/elm-autocomplete": "4.0.3 <= v < 5.0.0"
     },
     "elm-version": "0.18.0 <= v < 0.19.0"
 }

public/index.html

@@ -27,6 +27,14 @@
     app.ports.saveRegistration.subscribe(json => {
       localStorage.setItem("tooty.registration", json);
     });
+    app.ports.setStatus.subscribe(function(data) {
+      var element = document.getElementById(data.id);
+      if (element) {
+        element.value = data.status;
+        // Reset cursor at the end
+        element.focus();
+      }
+    });
     </script>
   </body>
 </html>

public/style.css

@@ -520,3 +520,74 @@ body {
 ::-webkit-scrollbar-corner {
     background: transparent;
 }
+
+/* Autocomplete */
+
+.autocomplete-menu {
+    position: relative;
+    margin-top: -10px;
+    min-width: 120px;
+}
+
+.autocomplete-list {
+    list-style: none;
+    padding: 0;
+    margin: auto;
+    max-height: 200px;
+    overflow-y: auto;
+}
+
+.autocomplete-item {
+    display: flex;
+    flex-wrap: nowrap;
+    justify-content: space-between;
+    align-content: stretch;
+    align-items: flex-start;
+    padding: 8px;
+    cursor: pointer;
+    background: #fff;
+    color: #777;
+    border-color: #bbb;
+    border-left-color: #272b30;
+    border-right-color: #272b30;
+}
+
+.autocomplete-item:hover,
+.autocomplete-item.active,
+.autocomplete-item.active:hover {
+  background: #ddd;
+  color: #777;
+  border-color: #bbb;
+  border-left-color: #272b30;
+  border-right-color: #272b30;
+}
+
+.autocomplete-item:first-child {
+  border-top-right-radius: 0;
+  border-top-left-radius: 0;
+}
+
+.autocomplete-item > img {
+    flex: 1 1 auto;
+    height: 20px;
+    width: 20px;
+    margin-right: 10px;
+    border-radius: 2px;
+}
+
+.autocomplete-item > strong {
+  flex: 100 1 auto;
+  align-self: auto;
+  white-space: nowrap;
+  overflow: hidden;
+  text-overflow: ellipsis;
+}
+
+.autocomplete-item > span {
+  flex: 100 1 auto;
+  text-align: right;
+  align-self: auto;
+  white-space: nowrap;
+  overflow: hidden;
+  text-overflow: ellipsis;
+}

src/Command.elm

@@ -15,6 +15,7 @@ module Command
         , loadThread
         , loadTimelines
         , postStatus
+        , updateDomStatus
         , deleteStatus
         , reblogStatus
         , unreblogStatus
@@ -25,6 +26,7 @@ module Command
         , focusId
         , scrollColumnToTop
         , scrollColumnToBottom
+        , searchAccounts
         )
 
 import Dom
@@ -167,6 +169,20 @@ loadAccountFollowing client accountId =
             Cmd.none
 
 
+searchAccounts : Maybe Client -> String -> Int -> Bool -> Cmd Msg
+searchAccounts client query limit resolve =
+    if query == "" then
+        Cmd.none
+    else
+        case client of
+            Just client ->
+                Mastodon.Http.searchAccounts client query limit resolve
+                    |> Mastodon.Http.send (MastodonEvent << AutoSearch)
+
+            Nothing ->
+                Cmd.none
+
+
 loadRelationships : Maybe Client -> List Int -> Cmd Msg
 loadRelationships client accountIds =
     case client of
@@ -218,6 +234,11 @@ postStatus client draft =
             Cmd.none
 
 
+updateDomStatus : String -> Cmd Msg
+updateDomStatus statusText =
+    Ports.setStatus { id = "status", status = statusText }
+
+
 deleteStatus : Maybe Client -> Int -> Cmd Msg
 deleteStatus client id =
     case client of

src/Mastodon/ApiUrl.elm

@@ -22,8 +22,11 @@ module Mastodon.ApiUrl
         , follow
         , unfollow
         , streaming
+        , searchAccount
         )
 
+import Mastodon.Encoder exposing (encodeUrl)
+
 
 type alias Server =
     String
@@ -69,15 +72,24 @@ userAccount server =
     server ++ accounts ++ "verify_credentials"
 
 
+searchAccount : Server -> String -> Int -> Bool -> String
+searchAccount server query limit resolve =
+    encodeUrl (server ++ accounts ++ "search")
+        [ ( "q", query )
+        , ( "limit", toString limit )
+        , ( "resolve"
+          , if resolve then
+                "true"
+            else
+                "false"
+          )
+        ]
+
+
 relationships : List Int -> String
 relationships ids =
-    let
+    encodeUrl (accounts ++ "relationships") <|
-        qs =
+        List.map (\id -> ( "id[]", toString id )) ids
-            ids
-                |> List.map (\id -> "id[]=" ++ (toString id))
-                |> String.join "&"
-    in
-        accounts ++ "relationships?" ++ qs
 
 
 followers : Int -> String

src/Mastodon/Helper.elm

@@ -52,6 +52,7 @@ toMention { id, url, username, acct } =
 notificationToAggregate : Notification -> NotificationAggregate
 notificationToAggregate notification =
     NotificationAggregate
+        notification.id
         notification.type_
         notification.status
         [ notification.account ]
@@ -142,6 +143,7 @@ aggregateNotifications notifications =
                 case statusGroup of
                     notification :: _ ->
                         [ NotificationAggregate
+                            notification.id
                             notification.type_
                             notification.status
                             accounts

src/Mastodon/Http.elm

@@ -24,6 +24,7 @@ module Mastodon.Http
         , deleteStatus
         , userAccount
         , send
+        , searchAccounts
         )
 
 import Http
@@ -154,6 +155,13 @@ fetchAccountFollowing client accountId =
     fetch client (ApiUrl.following accountId) <| Decode.list accountDecoder
 
 
+searchAccounts : Client -> String -> Int -> Bool -> Request (List Account)
+searchAccounts client query limit resolve =
+    HttpBuilder.get (ApiUrl.searchAccount client.server query limit resolve)
+        |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
+        |> HttpBuilder.withExpect (Http.expectJson (Decode.list accountDecoder))
+
+
 userAccount : Client -> Request Account
 userAccount client =
     HttpBuilder.get (ApiUrl.userAccount client.server)

src/Mastodon/Model.elm

@@ -138,7 +138,8 @@ type alias Notification =
 
 
 type alias NotificationAggregate =
-    { type_ : String
+    { id : Int
+    , type_ : String
     , status : Maybe Status
     , accounts : List Account
     , created_at : String

src/Model.elm

@@ -1,11 +1,14 @@
 module Model exposing (..)
 
+import Autocomplete
 import Command
 import Navigation
 import Mastodon.Decoder
 import Mastodon.Helper
 import Mastodon.Model exposing (..)
 import Mastodon.WebSocket
+import String.Extra
+import Task
 import Types exposing (..)
 
 
@@ -28,10 +31,17 @@ extractAuthCode { search } =
 defaultDraft : Draft
 defaultDraft =
     { status = ""
-    , in_reply_to = Nothing
+    , inReplyTo = Nothing
-    , spoiler_text = Nothing
+    , spoilerText = Nothing
     , sensitive = False
     , visibility = "public"
+    , autoState = Autocomplete.empty
+    , autoAtPosition = Nothing
+    , autoQuery = ""
+    , autoCursorPosition = 0
+    , autoMaxResults = 4
+    , autoAccounts = []
+    , showAutoMenu = False
     }
 
 
@@ -98,13 +108,13 @@ toStatusRequestBody : Draft -> StatusRequestBody
 toStatusRequestBody draft =
     { status = draft.status
     , in_reply_to_id =
-        case draft.in_reply_to of
+        case draft.inReplyTo of
             Just status ->
                 Just status.id
 
             Nothing ->
                 Nothing
-    , spoiler_text = draft.spoiler_text
+    , spoiler_text = draft.spoilerText
     , sensitive = draft.sensitive
     , visibility = draft.visibility
     }
@@ -182,47 +192,195 @@ processFollowEvent relationship flag model =
         }
 
 
-updateDraft : DraftMsg -> Account -> Draft -> ( Draft, Cmd Msg )
+updateDraft : DraftMsg -> Account -> Model -> ( Model, Cmd Msg )
-updateDraft draftMsg currentUser draft =
+updateDraft draftMsg currentUser model =
+    let
+        draft =
+            model.draft
+    in
         case draftMsg of
             ClearDraft ->
-            defaultDraft ! []
+                { model | draft = defaultDraft }
+                    ! [ Command.updateDomStatus defaultDraft.status ]
 
             ToggleSpoiler enabled ->
+                let
+                    newDraft =
                         { draft
-                | spoiler_text =
+                            | spoilerText =
                                 if enabled then
                                     Just ""
                                 else
                                     Nothing
                         }
-                ! []
+                in
+                    { model | draft = newDraft } ! []
 
             UpdateSensitive sensitive ->
-            { draft | sensitive = sensitive } ! []
+                { model | draft = { draft | sensitive = sensitive } } ! []
 
-        UpdateSpoiler spoiler_text ->
+            UpdateSpoiler spoilerText ->
-            { draft | spoiler_text = Just spoiler_text } ! []
+                { model | draft = { draft | spoilerText = Just spoilerText } } ! []
-
-        UpdateStatus status ->
-            { draft | status = status } ! []
 
             UpdateVisibility visibility ->
-            { draft | visibility = visibility } ! []
+                { model | draft = { draft | visibility = visibility } } ! []
 
             UpdateReplyTo status ->
+                let
+                    newStatus =
+                        Mastodon.Helper.getReplyPrefix currentUser status
+                in
+                    { model
+                        | draft =
                             { draft
-                | in_reply_to = Just status
+                                | inReplyTo = Just status
-                , status = Mastodon.Helper.getReplyPrefix currentUser status
+                                , status = newStatus
                                 , sensitive = Maybe.withDefault False status.sensitive
-                , spoiler_text =
+                                , spoilerText =
                                     if status.spoiler_text == "" then
                                         Nothing
                                     else
                                         Just status.spoiler_text
                                 , visibility = status.visibility
                             }
-                ! [ Command.focusId "status" ]
+                    }
+                        ! [ Command.focusId "status"
+                          , Command.updateDomStatus newStatus
+                          ]
+
+            UpdateInputInformation { status, selectionStart } ->
+                let
+                    stringToPos =
+                        String.slice 0 selectionStart status
+
+                    atPosition =
+                        case (String.right 1 stringToPos) of
+                            "@" ->
+                                Just selectionStart
+
+                            " " ->
+                                Nothing
+
+                            _ ->
+                                model.draft.autoAtPosition
+
+                    query =
+                        case atPosition of
+                            Just position ->
+                                String.slice position (String.length stringToPos) stringToPos
+
+                            Nothing ->
+                                ""
+
+                    newDraft =
+                        { draft
+                            | status = status
+                            , autoCursorPosition = selectionStart
+                            , autoAtPosition = atPosition
+                            , autoQuery = query
+                            , showAutoMenu =
+                                showAutoMenu
+                                    draft.autoAccounts
+                                    draft.autoAtPosition
+                                    draft.autoQuery
+                        }
+                in
+                    { model | draft = newDraft }
+                        ! if query /= "" && atPosition /= Nothing then
+                            [ Command.searchAccounts model.client query model.draft.autoMaxResults False ]
+                          else
+                            []
+
+            SelectAccount id ->
+                let
+                    account =
+                        List.filter (\account -> toString account.id == id) draft.autoAccounts
+                            |> List.head
+
+                    stringToAtPos =
+                        case draft.autoAtPosition of
+                            Just atPosition ->
+                                String.slice 0 atPosition draft.status
+
+                            _ ->
+                                ""
+
+                    stringToPos =
+                        String.slice 0 draft.autoCursorPosition draft.status
+
+                    newStatus =
+                        case draft.autoAtPosition of
+                            Just atPosition ->
+                                String.Extra.replaceSlice
+                                    (case account of
+                                        Just a ->
+                                            a.acct ++ " "
+
+                                        Nothing ->
+                                            ""
+                                    )
+                                    atPosition
+                                    ((String.length draft.autoQuery) + atPosition)
+                                    draft.status
+
+                            _ ->
+                                ""
+
+                    newDraft =
+                        { draft
+                            | status = newStatus
+                            , autoAtPosition = Nothing
+                            , autoQuery = ""
+                            , autoState = Autocomplete.empty
+                            , autoAccounts = []
+                            , showAutoMenu = False
+                        }
+                in
+                    { model | draft = newDraft }
+                        -- As we are using defaultValue, we need to update the textarea
+                        -- using a port.
+                        ! [ Command.updateDomStatus newStatus ]
+
+            SetAutoState autoMsg ->
+                let
+                    ( newState, maybeMsg ) =
+                        Autocomplete.update
+                            updateAutocompleteConfig
+                            autoMsg
+                            draft.autoMaxResults
+                            draft.autoState
+                            (acceptableAccounts draft.autoQuery draft.autoAccounts)
+
+                    newModel =
+                        { model | draft = { draft | autoState = newState } }
+                in
+                    case maybeMsg of
+                        Nothing ->
+                            newModel ! []
+
+                        Just updateMsg ->
+                            update updateMsg newModel
+
+            ResetAutocomplete toTop ->
+                let
+                    newDraft =
+                        { draft
+                            | autoState =
+                                if toTop then
+                                    Autocomplete.resetToFirstItem
+                                        updateAutocompleteConfig
+                                        (acceptableAccounts draft.autoQuery draft.autoAccounts)
+                                        draft.autoMaxResults
+                                        draft.autoState
+                                else
+                                    Autocomplete.resetToLastItem
+                                        updateAutocompleteConfig
+                                        (acceptableAccounts draft.autoQuery draft.autoAccounts)
+                                        draft.autoMaxResults
+                                        draft.autoState
+                        }
+                in
+                    { model | draft = newDraft } ! []
 
 
 updateViewer : ViewerMsg -> Maybe Viewer -> ( Maybe Viewer, Cmd Msg )
@@ -352,7 +510,9 @@ processMastodonEvent msg model =
 
         StatusPosted _ ->
             { model | draft = defaultDraft }
-                ! [ Command.scrollColumnToTop "home" ]
+                ! [ Command.scrollColumnToTop "home"
+                  , Command.updateDomStatus defaultDraft.status
+                  ]
 
         StatusDeleted result ->
             case result of
@@ -441,6 +601,51 @@ processMastodonEvent msg model =
                 Err error ->
                     { model | errors = (errorText error) :: model.errors } ! []
 
+        AutoSearch result ->
+            let
+                draft =
+                    model.draft
+            in
+                case result of
+                    Ok accounts ->
+                        { model
+                            | draft =
+                                { draft
+                                    | showAutoMenu =
+                                        showAutoMenu
+                                            accounts
+                                            draft.autoAtPosition
+                                            draft.autoQuery
+                                    , autoAccounts = accounts
+                                }
+                        }
+                            -- Force selection of the first item after each
+                            -- Successfull request
+                            ! [ Task.perform identity (Task.succeed ((DraftEvent << ResetAutocomplete) True)) ]
+
+                    Err error ->
+                        { model
+                            | draft = { draft | showAutoMenu = False }
+                            , errors = (errorText error) :: model.errors
+                        }
+                            ! []
+
+
+showAutoMenu : List Account -> Maybe Int -> String -> Bool
+showAutoMenu accounts atPosition query =
+    case ( List.isEmpty accounts, atPosition, query ) of
+        ( _, Nothing, _ ) ->
+            False
+
+        ( True, _, _ ) ->
+            False
+
+        ( _, _, "" ) ->
+            False
+
+        ( False, Just _, _ ) ->
+            True
+
 
 processWebSocketMsg : WebSocketMsg -> Model -> ( Model, Cmd Msg )
 processWebSocketMsg msg model =
@@ -588,11 +793,7 @@ update msg model =
         DraftEvent draftMsg ->
             case model.currentUser of
                 Just user ->
-                    let
+                    updateDraft draftMsg user model
-                        ( draft, commands ) =
-                            updateDraft draftMsg user model.draft
-                    in
-                        { model | draft = draft } ! [ commands ]
 
                 Nothing ->
                     model ! []
@@ -654,6 +855,39 @@ update msg model =
             model ! [ Command.scrollColumnToBottom column ]
 
 
+updateAutocompleteConfig : Autocomplete.UpdateConfig Msg Account
+updateAutocompleteConfig =
+    Autocomplete.updateConfig
+        { toId = .id >> toString
+        , onKeyDown =
+            \code maybeId ->
+                if code == 38 || code == 40 then
+                    Nothing
+                else if code == 13 then
+                    Maybe.map (DraftEvent << SelectAccount) maybeId
+                else
+                    Just <| (DraftEvent << ResetAutocomplete) False
+        , onTooLow = Just <| (DraftEvent << ResetAutocomplete) True
+        , onTooHigh = Just <| (DraftEvent << ResetAutocomplete) False
+        , onMouseEnter = \_ -> Nothing
+        , onMouseLeave = \_ -> Nothing
+        , onMouseClick = \id -> Just <| (DraftEvent << SelectAccount) id
+        , separateSelections = False
+        }
+
+
+acceptableAccounts : String -> List Account -> List Account
+acceptableAccounts query accounts =
+    let
+        lowerQuery =
+            String.toLower query
+    in
+        if query == "" then
+            []
+        else
+            List.filter (String.contains lowerQuery << String.toLower << .username) accounts
+
+
 subscriptions : Model -> Sub Msg
 subscriptions model =
     case model.client of
@@ -679,7 +913,9 @@ subscriptions model =
                                 ]
                            )
             in
-                Sub.batch <| List.map (Sub.map WebSocketEvent) subs
+                Sub.batch <|
+                    (List.map (Sub.map WebSocketEvent) subs)
+                        ++ [ Sub.map (DraftEvent << SetAutoState) Autocomplete.subscription ]
 
         Nothing ->
             Sub.batch []

src/Ports.elm

@@ -1,7 +1,10 @@
-port module Ports exposing (saveRegistration, saveClient)
+port module Ports exposing (saveRegistration, saveClient, setStatus)
 
 
 port saveRegistration : String -> Cmd msg
 
 
 port saveClient : String -> Cmd msg
+
+
+port setStatus : { id : String, status : String } -> Cmd msg

src/Types.elm

@@ -1,5 +1,6 @@
 module Types exposing (..)
 
+import Autocomplete
 import Mastodon.Model exposing (..)
 import Navigation
 
@@ -14,10 +15,13 @@ type DraftMsg
     = ClearDraft
     | UpdateSensitive Bool
     | UpdateSpoiler String
-    | UpdateStatus String
     | UpdateVisibility String
     | UpdateReplyTo Status
+    | SelectAccount String
     | ToggleSpoiler Bool
+    | UpdateInputInformation InputInformation
+    | ResetAutocomplete Bool
+    | SetAutoState Autocomplete.Msg
 
 
 type ViewerMsg
@@ -48,6 +52,7 @@ type MastodonMsg
     | StatusPosted (Result Error Status)
     | Unreblogged (Result Error Status)
     | UserTimeline (Result Error (List Status))
+    | AutoSearch (Result Error (List Account))
 
 
 type WebSocketMsg
@@ -105,10 +110,19 @@ type CurrentView
 
 type alias Draft =
     { status : String
-    , in_reply_to : Maybe Status
+    , inReplyTo : Maybe Status
-    , spoiler_text : Maybe String
+    , spoilerText : Maybe String
     , sensitive : Bool
     , visibility : String
+
+    -- Autocomplete values
+    , autoState : Autocomplete.State
+    , autoCursorPosition : Int
+    , autoAtPosition : Maybe Int
+    , autoQuery : String
+    , autoMaxResults : Int
+    , autoAccounts : List Account
+    , showAutoMenu : Bool
     }
 
 
@@ -159,3 +173,9 @@ type alias Model =
     , currentView : CurrentView
     , notificationFilter : NotificationFilter
     }
+
+
+type alias InputInformation =
+    { status : String
+    , selectionStart : Int
+    }

src/View.elm

@@ -1,17 +1,23 @@
 module View exposing (view)
 
+import Autocomplete
 import Dict
 import Html exposing (..)
+import Html.Keyed as Keyed
+import Html.Lazy exposing (lazy, lazy2, lazy3)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import List.Extra exposing (find, elemIndex, getAt)
 import Mastodon.Helper
 import Mastodon.Model exposing (..)
+import Model
 import Types exposing (..)
 import ViewHelper exposing (..)
 import Date
 import Date.Extra.Config.Config_en_au as DateEn
 import Date.Extra.Format as DateFormat
+import Json.Encode as Encode
+import Json.Decode as Decode
 
 
 type alias CurrentUser =
@@ -138,13 +144,19 @@ attachmentPreview context sensitive attachments ({ url, preview_url } as attachm
 
 attachmentListView : String -> Status -> Html Msg
 attachmentListView context { media_attachments, sensitive } =
+    let
+        keyedEntry attachments attachment =
+            ( toString attachment.id
+            , attachmentPreview context sensitive attachments attachment
+            )
+    in
         case media_attachments of
             [] ->
                 text ""
 
             attachments ->
-            ul [ class "attachments" ] <|
+                Keyed.ul [ class "attachments" ] <|
-                List.map (attachmentPreview context sensitive attachments) attachments
+                    List.map (keyedEntry attachments) attachments
 
 
 statusContentView : String -> Status -> Html Msg
@@ -190,7 +202,7 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as
                             [ text <| " @" ++ account.username ]
                         , text " boosted"
                         ]
-                    , statusView context reblog
+                    , lazy2 statusView context reblog
                     ]
 
             Nothing ->
@@ -202,7 +214,7 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as
                             , span [ class "acct" ] [ text <| " @" ++ account.username ]
                             ]
                         ]
-                    , statusContentView context status
+                    , lazy2 statusContentView context status
                     ]
 
 
@@ -311,14 +323,16 @@ accountView currentUser account relationship panelContent =
 
 accountTimelineView : CurrentUser -> List Status -> CurrentUserRelation -> Account -> Html Msg
 accountTimelineView currentUser statuses relationship account =
-    accountView currentUser account relationship <|
+    let
-        ul [ class "list-group" ] <|
+        keyedEntry status =
-            List.map
+            ( toString status.id
-                (\s ->
+            , li [ class "list-group-item status" ]
-                    li [ class "list-group-item status" ]
+                [ lazy2 statusView "account" status ]
-                        [ statusView "account" s ]
             )
-                statuses
+    in
+        accountView currentUser account relationship <|
+            Keyed.ul [ class "list-group" ] <|
+                List.map keyedEntry statuses
 
 
 accountFollowView :
@@ -329,18 +343,20 @@ accountFollowView :
     -> Account
     -> Html Msg
 accountFollowView currentUser accounts relationships relationship account =
-    accountView currentUser account relationship <|
+    let
-        ul [ class "list-group" ] <|
+        keyedEntry account =
-            List.map
+            ( toString account.id
-                (\account ->
+            , li [ class "list-group-item status" ]
-                    li [ class "list-group-item status" ]
                 [ followView
                     currentUser
                     (find (\r -> r.id == account.id) relationships)
                     account
                 ]
             )
-                accounts
+    in
+        accountView currentUser account relationship <|
+            Keyed.ul [ class "list-group" ] <|
+                List.map keyedEntry accounts
 
 
 statusActionsView : Status -> CurrentUser -> Html Msg
@@ -419,20 +435,24 @@ statusEntryView context className currentUser status =
                     ""
     in
         li [ class <| "list-group-item " ++ className ++ " " ++ nsfwClass ]
-            [ statusView context status
+            [ lazy2 statusView context status
-            , statusActionsView status currentUser
+            , lazy2 statusActionsView status currentUser
             ]
 
 
-timelineView : String -> String -> String -> CurrentUser -> List Status -> Html Msg
+timelineView : ( String, String, String, CurrentUser, List Status ) -> Html Msg
-timelineView label iconName context currentUser statuses =
+timelineView ( label, iconName, context, currentUser, statuses ) =
+    let
+        keyedEntry status =
+            ( toString id, statusEntryView context "" currentUser status )
+    in
         div [ class "col-md-3 column" ]
             [ div [ class "panel panel-default" ]
                 [ a
                     [ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop context ]
                     [ div [ class "panel-heading" ] [ icon iconName, text label ] ]
-            , ul [ id context, class "list-group timeline" ] <|
+                , Keyed.ul [ id context, class "list-group timeline" ] <|
-                List.map (statusEntryView context "" currentUser) statuses
+                    List.map keyedEntry statuses
                 ]
             ]
 
@@ -450,8 +470,8 @@ notificationHeading accounts str iconType =
         ]
 
 
-notificationStatusView : String -> CurrentUser -> Status -> NotificationAggregate -> Html Msg
+notificationStatusView : ( String, CurrentUser, Status, NotificationAggregate ) -> Html Msg
-notificationStatusView context currentUser status { type_, accounts } =
+notificationStatusView ( context, currentUser, status, { type_, accounts } ) =
     div [ class <| "notification " ++ type_ ]
         [ case type_ of
             "reblog" ->
@@ -462,8 +482,8 @@ notificationStatusView context currentUser status { type_, accounts } =
 
             _ ->
                 text ""
-        , statusView context status
+        , lazy2 statusView context status
-        , statusActionsView status currentUser
+        , lazy2 statusActionsView status currentUser
         ]
 
 
@@ -493,7 +513,7 @@ notificationEntryView currentUser notification =
     li [ class "list-group-item" ]
         [ case notification.status of
             Just status ->
-                notificationStatusView "notification" currentUser status notification
+                lazy notificationStatusView ( "notification", currentUser, status, notification )
 
             Nothing ->
                 notificationFollowView currentUser notification
@@ -526,16 +546,22 @@ notificationFilterView filter =
 
 notificationListView : CurrentUser -> NotificationFilter -> List NotificationAggregate -> Html Msg
 notificationListView currentUser filter notifications =
+    let
+        keyedEntry notification =
+            ( toString notification.id
+            , lazy2 notificationEntryView currentUser notification
+            )
+    in
         div [ class "col-md-3 column" ]
             [ div [ class "panel panel-default notifications-panel" ]
                 [ a
                     [ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop "notifications" ]
                     [ div [ class "panel-heading" ] [ icon "bell", text "Notifications" ] ]
                 , notificationFilterView filter
-            , ul [ id "notifications", class "list-group timeline" ] <|
+                , Keyed.ul [ id "notifications", class "list-group timeline" ] <|
                     (notifications
                         |> filterNotifications filter
-                    |> List.map (notificationEntryView currentUser)
+                        |> List.map keyedEntry
                     )
                 ]
             ]
@@ -543,7 +569,7 @@ notificationListView currentUser filter notifications =
 
 draftReplyToView : Draft -> Html Msg
 draftReplyToView draft =
-    case draft.in_reply_to of
+    case draft.inReplyTo of
         Just status ->
             div [ class "in-reply-to" ]
                 [ p []
@@ -557,7 +583,7 @@ draftReplyToView draft =
                         , text ")"
                         ]
                     ]
-                , div [ class "well" ] [ statusView "draft" status ]
+                , div [ class "well" ] [ lazy2 statusView "draft" status ]
                 ]
 
         Nothing ->
@@ -579,20 +605,26 @@ currentUserView currentUser =
 
 
 draftView : Model -> Html Msg
-draftView { draft, currentUser } =
+draftView ({ draft, currentUser } as model) =
     let
         hasSpoiler =
-            draft.spoiler_text /= Nothing
+            draft.spoilerText /= Nothing
 
         visibilityOptionView ( visibility, description ) =
             option [ value visibility ]
                 [ text <| visibility ++ ": " ++ description ]
+
+        autoMenu =
+            if draft.showAutoMenu then
+                viewAutocompleteMenu model.draft
+            else
+                text ""
     in
         div [ class "panel panel-default" ]
             [ div [ class "panel-heading" ]
                 [ icon "envelope"
                 , text <|
-                    if draft.in_reply_to /= Nothing then
+                    if draft.inReplyTo /= Nothing then
                         "Post a reply"
                     else
                         "Post a message"
@@ -622,7 +654,7 @@ draftView { draft, currentUser } =
                                 , placeholder "This text will always be visible."
                                 , onInput <| DraftEvent << UpdateSpoiler
                                 , required True
-                                , value <| Maybe.withDefault "" draft.spoiler_text
+                                , value <| Maybe.withDefault "" draft.spoilerText
                                 ]
                                 []
                             ]
@@ -636,7 +668,34 @@ draftView { draft, currentUser } =
                                 else
                                     "Status"
                             ]
-                        , textarea
+                        , let
+                            dec =
+                                (Decode.map
+                                    (\code ->
+                                        if code == 38 || code == 40 then
+                                            Ok NoOp
+                                        else
+                                            Err "not handling that key"
+                                    )
+                                    keyCode
+                                )
+                                    |> Decode.andThen fromResult
+
+                            options =
+                                { preventDefault = draft.showAutoMenu
+                                , stopPropagation = False
+                                }
+
+                            fromResult : Result String a -> Decode.Decoder a
+                            fromResult result =
+                                case result of
+                                    Ok val ->
+                                        Decode.succeed val
+
+                                    Err reason ->
+                                        Decode.fail reason
+                          in
+                            textarea
                                 [ id "status"
                                 , class "form-control"
                                 , rows 8
@@ -645,11 +704,14 @@ draftView { draft, currentUser } =
                                         "This text will be hidden by default, as you have enabled a spoiler."
                                     else
                                         "Once upon a time..."
-                            , onInput <| DraftEvent << UpdateStatus
                                 , required True
-                            , value draft.status
+                                , onInputInformation <| DraftEvent << UpdateInputInformation
+                                , onClickInformation <| DraftEvent << UpdateInputInformation
+                                , property "defaultValue" (Encode.string draft.status)
+                                , onWithOptions "keydown" options dec
                                 ]
                                 []
+                        , autoMenu
                         ]
                     , div [ class "form-group" ]
                         [ label [ for "visibility" ] [ text "Visibility" ]
@@ -712,12 +774,15 @@ threadView currentUser thread =
                 )
                 currentUser
                 status
+
+        keyedEntry status =
+            ( toString status.id, threadEntry status )
     in
         div [ class "col-md-3 column" ]
             [ div [ class "panel panel-default" ]
                 [ closeablePanelheading "thread" "list" "Thread" CloseThread
-                , ul [ id "thread", class "list-group timeline" ] <|
+                , Keyed.ul [ id "thread", class "list-group timeline" ] <|
-                    List.map threadEntry statuses
+                    List.map keyedEntry statuses
                 ]
             ]
 
@@ -740,8 +805,8 @@ optionsView model =
 sidebarView : Model -> Html Msg
 sidebarView model =
     div [ class "col-md-3 column" ]
-        [ draftView model
+        [ lazy draftView model
-        , optionsView model
+        , lazy optionsView model
         ]
 
 
@@ -753,30 +818,33 @@ homepageView model =
 
         Just currentUser ->
             div [ class "row" ]
-                [ sidebarView model
+                [ lazy sidebarView model
-                , timelineView
+                , lazy timelineView
-                    "Home timeline"
+                    ( "Home timeline"
-                    "home"
+                    , "home"
-                    "home"
+                    , "home"
-                    currentUser
+                    , currentUser
-                    model.userTimeline
+                    , model.userTimeline
-                , notificationListView currentUser model.notificationFilter model.notifications
+                    )
+                , lazy3 notificationListView currentUser model.notificationFilter model.notifications
                 , case model.currentView of
                     LocalTimelineView ->
-                        timelineView
+                        lazy timelineView
-                            "Local timeline"
+                            ( "Local timeline"
-                            "th-large"
+                            , "th-large"
-                            "local"
+                            , "local"
-                            currentUser
+                            , currentUser
-                            model.localTimeline
+                            , model.localTimeline
+                            )
 
                     GlobalTimelineView ->
-                        timelineView
+                        lazy timelineView
-                            "Global timeline"
+                            ( "Global timeline"
-                            "globe"
+                            , "globe"
-                            "global"
+                            , "global"
-                            currentUser
+                            , currentUser
-                            model.globalTimeline
+                            , model.globalTimeline
+                            )
 
                     AccountView account ->
                         accountTimelineView
@@ -900,6 +968,48 @@ viewerView { attachments, attachment } =
             ]
 
 
+viewAutocompleteMenu : Draft -> Html Msg
+viewAutocompleteMenu draft =
+    div [ class "autocomplete-menu" ]
+        [ Html.map (DraftEvent << SetAutoState)
+            (Autocomplete.view viewConfig
+                draft.autoMaxResults
+                draft.autoState
+                (Model.acceptableAccounts draft.autoQuery draft.autoAccounts)
+            )
+        ]
+
+
+viewConfig : Autocomplete.ViewConfig Mastodon.Model.Account
+viewConfig =
+    let
+        customizedLi keySelected mouseSelected account =
+            { attributes =
+                [ classList
+                    [ ( "list-group-item autocomplete-item", True )
+                    , ( "active", keySelected || mouseSelected )
+                    ]
+                ]
+            , children =
+                [ img [ src account.avatar ] []
+                , strong []
+                    [ text <|
+                        if account.display_name /= "" then
+                            account.display_name
+                        else
+                            account.acct
+                    ]
+                , span [] [ text <| " @" ++ account.acct ]
+                ]
+            }
+    in
+        Autocomplete.viewConfig
+            { toId = .id >> toString
+            , ul = [ class "list-group autocomplete-list" ]
+            , li = customizedLi
+            }
+
+
 view : Model -> Html Msg
 view model =
     div [ class "container-fluid" ]

src/ViewHelper.elm

@@ -2,6 +2,8 @@ module ViewHelper
     exposing
         ( formatContent
         , getMentionForLink
+        , onClickInformation
+        , onInputInformation
         , onClickWithStop
         , onClickWithPrevent
         , onClickWithPreventAndStop
@@ -11,7 +13,7 @@ module ViewHelper
 
 import Html exposing (..)
 import Html.Attributes exposing (..)
-import Html.Events exposing (onWithOptions)
+import Html.Events exposing (on, onWithOptions)
 import HtmlParser
 import Json.Decode as Decode
 import String.Extra exposing (replace)
@@ -22,6 +24,23 @@ import Types exposing (..)
 -- Custom Events
 
 
+onClickInformation : (InputInformation -> msg) -> Attribute msg
+onClickInformation msg =
+    on "mouseup" (Decode.map msg decodePositionInformation)
+
+
+onInputInformation : (InputInformation -> msg) -> Attribute msg
+onInputInformation msg =
+    on "input" (Decode.map msg decodePositionInformation)
+
+
+decodePositionInformation : Decode.Decoder InputInformation
+decodePositionInformation =
+    Decode.map2 InputInformation
+        (Decode.at [ "target", "value" ] Decode.string)
+        (Decode.at [ "target", "selectionStart" ] Decode.int)
+
+
 onClickWithPreventAndStop : msg -> Attribute msg
 onClickWithPreventAndStop msg =
     onWithOptions

tests/Fixtures.elm

@@ -6,15 +6,15 @@ import Mastodon.Model exposing (..)
 accountSkro : Account
 accountSkro =
     { acct = "SkroZoC"
-    , avatar = "https://mamot.fr/system/accounts/avatars/000/001/391/original/76be3c9d1b34f59b.jpeg?1493042489"
+    , avatar = ""
     , created_at = "2017-04-24T20:25:37.398Z"
     , display_name = "Skro"
     , followers_count = 77
     , following_count = 80
-    , header = "https://mamot.fr/system/accounts/headers/000/001/391/original/9fbb4ac980f04fe1.gif?1493042489"
+    , header = ""
     , id = 1391
     , locked = False
-    , note = "N'importe quoi très vite en 500 caractères. La responsabilité du triumvirat de ZoC ne peut être engagée."
+    , note = "Skro note"
     , statuses_count = 161
     , url = "https://mamot.fr/@SkroZoC"
     , username = "SkroZoC"
@@ -24,15 +24,15 @@ accountSkro =
 accountVjousse : Account
 accountVjousse =
     { acct = "vjousse"
-    , avatar = "https://mamot.fr/system/accounts/avatars/000/026/303/original/b72c0dd565e5bc1e.png?1492698808"
+    , avatar = ""
     , created_at = "2017-04-20T14:31:05.751Z"
     , display_name = "Vincent Jousse"
     , followers_count = 68
     , following_count = 31
-    , header = "https://mamot.fr/headers/original/missing.png"
+    , header = ""
     , id = 26303
     , locked = False
-    , note = "Libriste, optimiste et utopiste. On est bien tintin."
+    , note = "Vjousse note"
     , statuses_count = 88
     , url = "https://mamot.fr/@vjousse"
     , username = "vjousse"
@@ -42,15 +42,15 @@ accountVjousse =
 accountNico : Account
 accountNico =
     { acct = "n1k0"
-    , avatar = "https://mamot.fr/system/accounts/avatars/000/017/784/original/40052904e484d9c0.jpg?1492158615"
+    , avatar = ""
     , created_at = "2017-04-14T08:28:59.706Z"
     , display_name = "NiKo`"
     , followers_count = 162
     , following_count = 79
-    , header = "https://mamot.fr/system/accounts/headers/000/017/784/original/ea87200d852018a8.jpg?1492158674"
+    , header = ""
     , id = 17784
     , locked = False
-    , note = "Transforme sa procrastination en pouets, la plupart du temps en français."
+    , note = "Niko note"
     , statuses_count = 358
     , url = "https://mamot.fr/@n1k0"
     , username = "n1k0"
@@ -60,15 +60,15 @@ accountNico =
 accountPloum : Account
 accountPloum =
     { acct = "ploum"
-    , avatar = "https://mamot.fr/system/accounts/avatars/000/006/840/original/593a817d651d9253.jpg?1491814416"
+    , avatar = ""
     , created_at = "2017-04-08T09:37:34.931Z"
     , display_name = "ploum"
     , followers_count = 1129
     , following_count = 91
-    , header = "https://mamot.fr/system/accounts/headers/000/006/840/original/7e0adc1f754dafbe.jpg?1491814416"
+    , header = ""
     , id = 6840
     , locked = False
-    , note = "Futurologue, conférencier, blogueur et écrivain électronique. Du moins, je l'espère. :bicyclist:"
+    , note = "Ploum note"
     , statuses_count = 601
     , url = "https://mamot.fr/@ploum"
     , username = "ploum"
@@ -78,7 +78,7 @@ accountPloum =
 statusNicoToVjousse : Status
 statusNicoToVjousse =
     { account = accountNico
-    , content = "<p><span class=\"h-card\"><a href=\"https://mamot.fr/@vjousse\" class=\"u-url mention\">@<span>vjousse</span></a></span> j&apos;ai rien touché à ce niveau là non</p>"
+    , content = "<p>@vjousse coucou</p>"
     , created_at = "2017-04-24T20:16:20.922Z"
     , favourited = Nothing
     , favourites_count = 0
@@ -108,7 +108,7 @@ statusNicoToVjousse =
 statusNicoToVjousseAgain : Status
 statusNicoToVjousseAgain =
     { account = accountNico
-    , content = "<p><span class=\"h-card\"><a href=\"https://mamot.fr/@vjousse\" class=\"u-url mention\">@<span>vjousse</span></a></span> oui j&apos;ai vu, c&apos;est super, après on est à +473 −13, à un moment tu vas te prendre la tête 😂</p>"
+    , content = "<p>@vjousse recoucou</p>"
     , created_at = "2017-04-25T07:41:23.492Z"
     , favourited = Nothing
     , favourites_count = 0
@@ -258,13 +258,3 @@ duplicateAccountNotifications =
     , notificationSkroFollowsVjousse
     , notificationSkroFollowsVjousse
     ]
-
-
-notificationAggregates : List NotificationAggregate
-notificationAggregates =
-    [ { type_ = "mention"
-      , status = Nothing
-      , accounts = []
-      , created_at = ""
-      }
-    ]

tests/MastodonTest/HelperTest.elm

@@ -38,12 +38,14 @@ all =
                         Fixtures.notifications
                             |> aggregateNotifications
                             |> Expect.equal
-                                [ { type_ = "mention"
+                                [ { id = .id Fixtures.notificationNicoMentionVjousse
+                                  , type_ = "mention"
                                   , status = Just Fixtures.statusNicoToVjousse
                                   , accounts = [ Fixtures.accountNico ]
                                   , created_at = "2017-04-24T20:16:20.973Z"
                                   }
-                                , { type_ = "follow"
+                                , { id = .id Fixtures.notificationNicoFollowsVjousse
+                                  , type_ = "follow"
                                   , status = Nothing
                                   , accounts = [ Fixtures.accountNico, Fixtures.accountSkro ]
                                   , created_at = "2017-04-24T20:13:47.431Z"
@@ -61,12 +63,14 @@ all =
                             |> aggregateNotifications
                             |> (addNotificationToAggregates Fixtures.notificationPloumFollowsVjousse)
                             |> Expect.equal
-                                [ { type_ = "mention"
+                                [ { id = .id Fixtures.notificationNicoMentionVjousse
+                                  , type_ = "mention"
                                   , status = Just Fixtures.statusNicoToVjousse
                                   , accounts = [ Fixtures.accountNico ]
                                   , created_at = "2017-04-24T20:16:20.973Z"
                                   }
-                                , { type_ = "follow"
+                                , { id = .id Fixtures.notificationNicoFollowsVjousse
+                                  , type_ = "follow"
                                   , status = Nothing
                                   , accounts = [ Fixtures.accountPloum, Fixtures.accountNico, Fixtures.accountSkro ]
                                   , created_at = "2017-04-24T20:13:47.431Z"
@@ -78,12 +82,14 @@ all =
                             |> aggregateNotifications
                             |> (addNotificationToAggregates Fixtures.notificationNicoMentionVjousse)
                             |> Expect.equal
-                                [ { type_ = "mention"
+                                [ { id = .id Fixtures.notificationNicoMentionVjousse
+                                  , type_ = "mention"
                                   , status = Just Fixtures.statusNicoToVjousse
                                   , accounts = [ Fixtures.accountNico, Fixtures.accountNico ]
                                   , created_at = "2017-04-24T20:16:20.973Z"
                                   }
-                                , { type_ = "follow"
+                                , { id = .id Fixtures.notificationNicoFollowsVjousse
+                                  , type_ = "follow"
                                   , status = Nothing
                                   , accounts = [ Fixtures.accountNico, Fixtures.accountSkro ]
                                   , created_at = "2017-04-24T20:13:47.431Z"
@@ -95,17 +101,20 @@ all =
                             |> aggregateNotifications
                             |> (addNotificationToAggregates Fixtures.notificationNicoMentionVjousseAgain)
                             |> Expect.equal
-                                [ { type_ = "mention"
+                                [ { id = .id Fixtures.notificationNicoMentionVjousseAgain
+                                  , type_ = "mention"
                                   , status = Just Fixtures.statusNicoToVjousseAgain
                                   , accounts = [ Fixtures.accountNico ]
                                   , created_at = "2017-04-25T07:41:23.546Z"
                                   }
-                                , { type_ = "mention"
+                                , { id = .id Fixtures.notificationNicoMentionVjousse
+                                  , type_ = "mention"
                                   , status = Just Fixtures.statusNicoToVjousse
                                   , accounts = [ Fixtures.accountNico ]
                                   , created_at = "2017-04-24T20:16:20.973Z"
                                   }
-                                , { type_ = "follow"
+                                , { id = .id Fixtures.notificationNicoFollowsVjousse
+                                  , type_ = "follow"
                                   , status = Nothing
                                   , accounts = [ Fixtures.accountNico, Fixtures.accountSkro ]
                                   , created_at = "2017-04-24T20:13:47.431Z"