flewkey/tooty
1
0
Fork 0
Code Releases Activity

Modularize the Mastodon package. (#70)

Browse Source
This commit is contained in:
Nicolas Perriault 2017-04-27 16:34:27 +02:00 committed by GitHub
parent f983e00387
commit f5b41aa155
16 changed files with 964 additions and 913 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
elm-package.json
View File

@ -10,6 +10,7 @@
"dependencies": { "dependencies": {
"NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
"elm-community/list-extra": "6.0.0 <= v < 7.0.0", "elm-community/list-extra": "6.0.0 <= v < 7.0.0",
"elm-community/string-extra": "1.3.3 <= v < 2.0.0",
"elm-lang/core": "5.1.1 <= v < 6.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0",
"elm-lang/dom": "1.1.1 <= v < 2.0.0", "elm-lang/dom": "1.1.1 <= v < 2.0.0",
"elm-lang/html": "2.0.0 <= v < 3.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0",

774
src/Mastodon.elm
View File

@ -1,774 +0,0 @@
module Mastodon
exposing
( AccessTokenResult
, Account
, AppRegistration
, Attachment
, Client
, Error(..)
, Mention
, Notification
, NotificationAggregate
, Reblog(..)
, Status
, StatusRequestBody
, StreamType(..)
, Tag
, WebSocketEvent(..)
, reblog
, unreblog
, favourite
, unfavourite
, extractReblog
, register
, registrationEncoder
, aggregateNotifications
, clientEncoder
, decodeWebSocketMessage
, getAuthorizationUrl
, getAccessToken
, fetchAccount
, fetchLocalTimeline
, fetchNotifications
, fetchGlobalTimeline
, fetchUserTimeline
, postStatus
, send
, subscribeToWebSockets
, notificationDecoder
, addNotificationToAggregates
, notificationToAggregate
)
import Http
import HttpBuilder
import Json.Decode.Pipeline as Pipe
import Json.Decode as Decode
import Json.Encode as Encode
import Util
import WebSocket
import List.Extra exposing (groupWhile)
import Mastodon.ApiUrl as ApiUrl
-- Types
type alias AccountId =
Int
type alias AuthCode =
String
type alias ClientId =
String
type alias ClientSecret =
String
type alias Server =
String
type alias StatusCode =
Int
type alias StatusMsg =
String
type alias Token =
String
type Error
= MastodonError StatusCode StatusMsg String
| ServerError StatusCode StatusMsg String
| TimeoutError
| NetworkError
type alias AccessTokenResult =
{ server : Server
, accessToken : Token
}
type alias Client =
{ server : Server
, token : Token
}
type alias AppRegistration =
{ server : Server
, scope : String
, client_id : ClientId
, client_secret : ClientSecret
, id : Int
, redirect_uri : String
}
type alias Account =
{ acct : String
, avatar : String
, created_at : String
, display_name : String
, followers_count : Int
, following_count : Int
, header : String
, id : AccountId
, locked : Bool
, note : String
, statuses_count : Int
, url : String
, username : String
}
type alias Attachment =
-- type_: -- "image", "video", "gifv"
{ id : Int
, type_ : String
, url : String
, remote_url : String
, preview_url : String
, text_url : Maybe String
}
type alias Mention =
{ id : AccountId
, url : String
, username : String
, acct : String
}
type alias Notification =
{-
- id: The notification ID
- type_: One of: "mention", "reblog", "favourite", "follow"
- created_at: The time the notification was created
- account: The Account sending the notification to the user
- status: The Status associated with the notification, if applicable
-}
{ id : Int
, type_ : String
, created_at : String
, account : Account
, status : Maybe Status
}
type alias NotificationAggregate =
{ type_ : String
, status : Maybe Status
, accounts : List Account
, created_at : String
}
type alias Tag =
{ name : String
, url : String
}
type alias Status =
{ account : Account
, content : String
, created_at : String
, favourited : Maybe Bool
, favourites_count : Int
, id : Int
, in_reply_to_account_id : Maybe Int
, in_reply_to_id : Maybe Int
, media_attachments : List Attachment
, mentions : List Mention
, reblog : Maybe Reblog
, reblogged : Maybe Bool
, reblogs_count : Int
, sensitive : Maybe Bool
, spoiler_text : String
, tags : List Tag
, uri : String
, url : String
, visibility : String
}
type Reblog
= Reblog Status
type alias StatusRequestBody =
-- status: The text of the status
-- in_reply_to_id: local ID of the status you want to reply to
-- sensitive: set this to mark the media of the status as NSFW
-- spoiler_text: text to be shown as a warning before the actual content
-- visibility: either "direct", "private", "unlisted" or "public"
-- TODO: media_ids: array of media IDs to attach to the status (maximum 4)
{ status : String
, in_reply_to_id : Maybe Int
, spoiler_text : Maybe String
, sensitive : Bool
, visibility : String
}
type alias Request a =
HttpBuilder.RequestBuilder a
type StreamType
= UserStream
| LocalPublicStream
| GlobalPublicStream
type WebSocketEvent
= StatusUpdateEvent (Result String Status)
| NotificationEvent (Result String Notification)
| StatusDeleteEvent (Result String Int)
| ErrorEvent String
type WebSocketPayload
= StringPayload String
| IntPayload Int
type alias WebSocketMessage =
{ event : String
, payload : WebSocketPayload
}
-- Encoders
appRegistrationEncoder : String -> String -> String -> String -> Encode.Value
appRegistrationEncoder client_name redirect_uris scope website =
Encode.object
[ ( "client_name", Encode.string client_name )
, ( "redirect_uris", Encode.string redirect_uris )
, ( "scopes", Encode.string scope )
, ( "website", Encode.string website )
]
authorizationCodeEncoder : AppRegistration -> AuthCode -> Encode.Value
authorizationCodeEncoder registration authCode =
Encode.object
[ ( "client_id", Encode.string registration.client_id )
, ( "client_secret", Encode.string registration.client_secret )
, ( "grant_type", Encode.string "authorization_code" )
, ( "redirect_uri", Encode.string registration.redirect_uri )
, ( "code", Encode.string authCode )
]
statusRequestBodyEncoder : StatusRequestBody -> Encode.Value
statusRequestBodyEncoder statusData =
Encode.object
[ ( "status", Encode.string statusData.status )
, ( "in_reply_to_id", encodeMaybe Encode.int statusData.in_reply_to_id )
, ( "spoiler_text", encodeMaybe Encode.string statusData.spoiler_text )
, ( "sensitive", Encode.bool statusData.sensitive )
, ( "visibility", Encode.string statusData.visibility )
]
-- Decoders
appRegistrationDecoder : Server -> String -> Decode.Decoder AppRegistration
appRegistrationDecoder server scope =
Pipe.decode AppRegistration
|> Pipe.hardcoded server
|> Pipe.hardcoded scope
|> Pipe.required "client_id" Decode.string
|> Pipe.required "client_secret" Decode.string
|> Pipe.required "id" Decode.int
|> Pipe.required "redirect_uri" Decode.string
accessTokenDecoder : AppRegistration -> Decode.Decoder AccessTokenResult
accessTokenDecoder registration =
Pipe.decode AccessTokenResult
|> Pipe.hardcoded registration.server
|> Pipe.required "access_token" Decode.string
accountDecoder : Decode.Decoder Account
accountDecoder =
Pipe.decode Account
|> Pipe.required "acct" Decode.string
|> Pipe.required "avatar" Decode.string
|> Pipe.required "created_at" Decode.string
|> Pipe.required "display_name" Decode.string
|> Pipe.required "followers_count" Decode.int
|> Pipe.required "following_count" Decode.int
|> Pipe.required "header" Decode.string
|> Pipe.required "id" Decode.int
|> Pipe.required "locked" Decode.bool
|> Pipe.required "note" Decode.string
|> Pipe.required "statuses_count" Decode.int
|> Pipe.required "url" Decode.string
|> Pipe.required "username" Decode.string
attachmentDecoder : Decode.Decoder Attachment
attachmentDecoder =
Pipe.decode Attachment
|> Pipe.required "id" Decode.int
|> Pipe.required "type" Decode.string
|> Pipe.required "url" Decode.string
|> Pipe.required "remote_url" Decode.string
|> Pipe.required "preview_url" Decode.string
|> Pipe.required "text_url" (Decode.nullable Decode.string)
mentionDecoder : Decode.Decoder Mention
mentionDecoder =
Pipe.decode Mention
|> Pipe.required "id" Decode.int
|> Pipe.required "url" Decode.string
|> Pipe.required "username" Decode.string
|> Pipe.required "acct" Decode.string
notificationDecoder : Decode.Decoder Notification
notificationDecoder =
Pipe.decode Notification
|> Pipe.required "id" Decode.int
|> Pipe.required "type" Decode.string
|> Pipe.required "created_at" Decode.string
|> Pipe.required "account" accountDecoder
|> Pipe.optional "status" (Decode.nullable statusDecoder) Nothing
tagDecoder : Decode.Decoder Tag
tagDecoder =
Pipe.decode Tag
|> Pipe.required "name" Decode.string
|> Pipe.required "url" Decode.string
reblogDecoder : Decode.Decoder Reblog
reblogDecoder =
Decode.map Reblog (Decode.lazy (\_ -> statusDecoder))
statusDecoder : Decode.Decoder Status
statusDecoder =
Pipe.decode Status
|> Pipe.required "account" accountDecoder
|> Pipe.required "content" Decode.string
|> Pipe.required "created_at" Decode.string
|> Pipe.optional "favourited" (Decode.nullable Decode.bool) Nothing
|> Pipe.required "favourites_count" Decode.int
|> Pipe.required "id" Decode.int
|> Pipe.required "in_reply_to_account_id" (Decode.nullable Decode.int)
|> Pipe.required "in_reply_to_id" (Decode.nullable Decode.int)
|> Pipe.required "media_attachments" (Decode.list attachmentDecoder)
|> Pipe.required "mentions" (Decode.list mentionDecoder)
|> Pipe.optional "reblog" (Decode.nullable reblogDecoder) Nothing
|> Pipe.optional "reblogged" (Decode.nullable Decode.bool) Nothing
|> Pipe.required "reblogs_count" Decode.int
|> Pipe.required "sensitive" (Decode.nullable Decode.bool)
|> Pipe.required "spoiler_text" Decode.string
|> Pipe.required "tags" (Decode.list tagDecoder)
|> Pipe.required "uri" Decode.string
|> Pipe.required "url" Decode.string
|> Pipe.required "visibility" Decode.string
webSocketPayloadDecoder : Decode.Decoder WebSocketPayload
webSocketPayloadDecoder =
Decode.oneOf
[ Decode.map StringPayload Decode.string
, Decode.map IntPayload Decode.int
]
webSocketEventDecoder : Decode.Decoder WebSocketMessage
webSocketEventDecoder =
Pipe.decode WebSocketMessage
|> Pipe.required "event" Decode.string
|> Pipe.required "payload" webSocketPayloadDecoder
-- Internal helpers
encodeMaybe : (a -> Encode.Value) -> Maybe a -> Encode.Value
encodeMaybe encode thing =
case thing of
Nothing ->
Encode.null
Just value ->
encode value
encodeUrl : String -> List ( String, String ) -> String
encodeUrl base params =
List.map (\( k, v ) -> k ++ "=" ++ Http.encodeUri v) params
|> String.join "&"
|> (++) (base ++ "?")
mastodonErrorDecoder : Decode.Decoder String
mastodonErrorDecoder =
Decode.field "error" Decode.string
extractMastodonError : StatusCode -> StatusMsg -> String -> Error
extractMastodonError statusCode statusMsg body =
case Decode.decodeString mastodonErrorDecoder body of
Ok errRecord ->
MastodonError statusCode statusMsg errRecord
Err err ->
ServerError statusCode statusMsg err
extractError : Http.Error -> Error
extractError error =
case error of
Http.BadStatus { status, body } ->
extractMastodonError status.code status.message body
Http.BadPayload str { status } ->
ServerError
status.code
status.message
("Failed decoding JSON: " ++ str)
Http.Timeout ->
TimeoutError
_ ->
NetworkError
extractReblog : Status -> Status
extractReblog status =
case status.reblog of
Just (Reblog reblog) ->
reblog
Nothing ->
status
toResponse : Result Http.Error a -> Result Error a
toResponse result =
Result.mapError extractError result
fetch : Client -> String -> Decode.Decoder a -> Request a
fetch client endpoint decoder =
HttpBuilder.get (client.server ++ endpoint)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson decoder)
-- Public API
notificationToAggregate : Notification -> NotificationAggregate
notificationToAggregate notification =
NotificationAggregate
notification.type_
notification.status
[ notification.account ]
notification.created_at
addNotificationToAggregates : Notification -> List NotificationAggregate -> List NotificationAggregate
addNotificationToAggregates notification aggregates =
let
addNewAccountToSameStatus : NotificationAggregate -> Notification -> NotificationAggregate
addNewAccountToSameStatus aggregate notification =
case ( aggregate.status, notification.status ) of
( Just aggregateStatus, Just notificationStatus ) ->
if aggregateStatus.id == notificationStatus.id then
{ aggregate | accounts = notification.account :: aggregate.accounts }
else
aggregate
( _, _ ) ->
aggregate
{-
Let's try to find an already existing aggregate, matching the notification
we are trying to add.
If we find any aggregate, we modify it inplace. If not, we return the
aggregates unmodified
-}
newAggregates =
aggregates
|> List.map
(\aggregate ->
case ( aggregate.type_, notification.type_ ) of
{-
Notification and aggregate are of the follow type.
Add the new following account.
-}
( "follow", "follow" ) ->
{ aggregate | accounts = notification.account :: aggregate.accounts }
{-
Notification is of type follow, but current aggregate
is of another type. Let's continue then.
-}
( _, "follow" ) ->
aggregate
{-
If both types are the same check if we should
add the new account.
-}
( aggregateType, notificationType ) ->
if aggregateType == notificationType then
addNewAccountToSameStatus aggregate notification
else
aggregate
)
in
{-
If we did no modification to the old aggregates it's
because we didn't found any match. So me have to create
a new aggregate
-}
if newAggregates == aggregates then
notificationToAggregate (notification) :: aggregates
else
newAggregates
aggregateNotifications : List Notification -> List NotificationAggregate
aggregateNotifications notifications =
let
only type_ notifications =
List.filter (\n -> n.type_ == type_) notifications
sameStatus n1 n2 =
case ( n1.status, n2.status ) of
( Just r1, Just r2 ) ->
r1.id == r2.id
_ ->
False
extractAggregate statusGroup =
let
accounts =
List.map .account statusGroup
in
case statusGroup of
notification :: _ ->
[ NotificationAggregate
notification.type_
notification.status
accounts
notification.created_at
]
[] ->
[]
aggregate statusGroups =
List.map extractAggregate statusGroups |> List.concat
in
[ notifications |> only "reblog" |> groupWhile sameStatus |> aggregate
, notifications |> only "favourite" |> groupWhile sameStatus |> aggregate
, notifications |> only "mention" |> groupWhile sameStatus |> aggregate
, notifications |> only "follow" |> groupWhile (\_ _ -> True) |> aggregate
]
|> List.concat
|> List.sortBy .created_at
|> List.reverse
clientEncoder : Client -> Encode.Value
clientEncoder client =
Encode.object
[ ( "server", Encode.string client.server )
, ( "token", Encode.string client.token )
]
registrationEncoder : AppRegistration -> Encode.Value
registrationEncoder registration =
Encode.object
[ ( "server", Encode.string registration.server )
, ( "scope", Encode.string registration.scope )
, ( "client_id", Encode.string registration.client_id )
, ( "client_secret", Encode.string registration.client_secret )
, ( "id", Encode.int registration.id )
, ( "redirect_uri", Encode.string registration.redirect_uri )
]
register : Server -> String -> String -> String -> String -> Request AppRegistration
register server client_name redirect_uri scope website =
HttpBuilder.post (ApiUrl.apps server)
|> HttpBuilder.withExpect (Http.expectJson (appRegistrationDecoder server scope))
|> HttpBuilder.withJsonBody (appRegistrationEncoder client_name redirect_uri scope website)
getAuthorizationUrl : AppRegistration -> String
getAuthorizationUrl registration =
encodeUrl (ApiUrl.oauthAuthorize registration.server)
[ ( "response_type", "code" )
, ( "client_id", registration.client_id )
, ( "scope", registration.scope )
, ( "redirect_uri", registration.redirect_uri )
]
getAccessToken : AppRegistration -> AuthCode -> Request AccessTokenResult
getAccessToken registration authCode =
HttpBuilder.post (ApiUrl.oauthToken registration.server)
|> HttpBuilder.withExpect (Http.expectJson (accessTokenDecoder registration))
|> HttpBuilder.withJsonBody (authorizationCodeEncoder registration authCode)
send : (Result Error a -> msg) -> Request a -> Cmd msg
send tagger builder =
builder |> HttpBuilder.send (toResponse >> tagger)
fetchAccount : Client -> AccountId -> Request Account
fetchAccount client accountId =
fetch client (ApiUrl.account accountId) accountDecoder
fetchUserTimeline : Client -> Request (List Status)
fetchUserTimeline client =
fetch client ApiUrl.homeTimeline <| Decode.list statusDecoder
fetchLocalTimeline : Client -> Request (List Status)
fetchLocalTimeline client =
fetch client (ApiUrl.publicTimeline (Just "public")) <| Decode.list statusDecoder
fetchGlobalTimeline : Client -> Request (List Status)
fetchGlobalTimeline client =
fetch client (ApiUrl.publicTimeline (Nothing)) <| Decode.list statusDecoder
fetchNotifications : Client -> Request (List Notification)
fetchNotifications client =
fetch client (ApiUrl.notifications) <| Decode.list notificationDecoder
postStatus : Client -> StatusRequestBody -> Request Status
postStatus client statusRequestBody =
HttpBuilder.post (ApiUrl.statuses client.server)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
|> HttpBuilder.withJsonBody (statusRequestBodyEncoder statusRequestBody)
reblog : Client -> Int -> Request Status
reblog client id =
HttpBuilder.post (ApiUrl.reblog client.server id)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
unreblog : Client -> Int -> Request Status
unreblog client id =
HttpBuilder.post (ApiUrl.unreblog client.server id)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
favourite : Client -> Int -> Request Status
favourite client id =
HttpBuilder.post (ApiUrl.favourite client.server id)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
unfavourite : Client -> Int -> Request Status
unfavourite client id =
HttpBuilder.post (ApiUrl.unfavourite client.server id)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
subscribeToWebSockets : Client -> StreamType -> (String -> a) -> Sub a
subscribeToWebSockets client streamType message =
let
type_ =
case streamType of
GlobalPublicStream ->
"public"
LocalPublicStream ->
"public:local"
UserStream ->
"user"
url =
encodeUrl
(ApiUrl.streaming (Util.replace "https:" "wss:" client.server))
[ ( "access_token", client.token )
, ( "stream", type_ )
]
in
WebSocket.listen url message
decodeWebSocketMessage : String -> WebSocketEvent
decodeWebSocketMessage message =
case (Decode.decodeString webSocketEventDecoder message) of
Ok message ->
case message.event of
"update" ->
case message.payload of
StringPayload payload ->
StatusUpdateEvent (Decode.decodeString statusDecoder payload)
_ ->
ErrorEvent "WS status update event payload must be a string"
"delete" ->
case message.payload of
IntPayload payload ->
StatusDeleteEvent <| Ok payload
_ ->
ErrorEvent "WS status delete event payload must be an int"
"notification" ->
case message.payload of
StringPayload payload ->
NotificationEvent (Decode.decodeString notificationDecoder payload)
_ ->
ErrorEvent "WS notification event payload must be an string"
event ->
ErrorEvent <| "Unknown WS event " ++ event
Err error ->
ErrorEvent error

179
src/Mastodon/Decoder.elm Normal file
View File

@ -0,0 +1,179 @@
module Mastodon.Decoder
exposing
( appRegistrationDecoder
, accessTokenDecoder
, accountDecoder
, attachmentDecoder
, decodeWebSocketMessage
, mastodonErrorDecoder
, mentionDecoder
, notificationDecoder
, tagDecoder
, reblogDecoder
, statusDecoder
, webSocketPayloadDecoder
, webSocketEventDecoder
)
import Json.Decode as Decode
import Json.Decode.Pipeline as Pipe
import Mastodon.Model exposing (..)
import Mastodon.WebSocket exposing (..)
appRegistrationDecoder : String -> String -> Decode.Decoder AppRegistration
appRegistrationDecoder server scope =
Pipe.decode AppRegistration
|> Pipe.hardcoded server
|> Pipe.hardcoded scope
|> Pipe.required "client_id" Decode.string
|> Pipe.required "client_secret" Decode.string
|> Pipe.required "id" Decode.int
|> Pipe.required "redirect_uri" Decode.string
accessTokenDecoder : AppRegistration -> Decode.Decoder AccessTokenResult
accessTokenDecoder registration =
Pipe.decode AccessTokenResult
|> Pipe.hardcoded registration.server
|> Pipe.required "access_token" Decode.string
accountDecoder : Decode.Decoder Account
accountDecoder =
Pipe.decode Account
|> Pipe.required "acct" Decode.string
|> Pipe.required "avatar" Decode.string
|> Pipe.required "created_at" Decode.string
|> Pipe.required "display_name" Decode.string
|> Pipe.required "followers_count" Decode.int
|> Pipe.required "following_count" Decode.int
|> Pipe.required "header" Decode.string
|> Pipe.required "id" Decode.int
|> Pipe.required "locked" Decode.bool
|> Pipe.required "note" Decode.string
|> Pipe.required "statuses_count" Decode.int
|> Pipe.required "url" Decode.string
|> Pipe.required "username" Decode.string
attachmentDecoder : Decode.Decoder Attachment
attachmentDecoder =
Pipe.decode Attachment
|> Pipe.required "id" Decode.int
|> Pipe.required "type" Decode.string
|> Pipe.required "url" Decode.string
|> Pipe.required "remote_url" Decode.string
|> Pipe.required "preview_url" Decode.string
|> Pipe.required "text_url" (Decode.nullable Decode.string)
mastodonErrorDecoder : Decode.Decoder String
mastodonErrorDecoder =
Decode.field "error" Decode.string
mentionDecoder : Decode.Decoder Mention
mentionDecoder =
Pipe.decode Mention
|> Pipe.required "id" Decode.int
|> Pipe.required "url" Decode.string
|> Pipe.required "username" Decode.string
|> Pipe.required "acct" Decode.string
notificationDecoder : Decode.Decoder Notification
notificationDecoder =
Pipe.decode Notification
|> Pipe.required "id" Decode.int
|> Pipe.required "type" Decode.string
|> Pipe.required "created_at" Decode.string
|> Pipe.required "account" accountDecoder
|> Pipe.optional "status" (Decode.nullable statusDecoder) Nothing
tagDecoder : Decode.Decoder Tag
tagDecoder =
Pipe.decode Tag
|> Pipe.required "name" Decode.string
|> Pipe.required "url" Decode.string
reblogDecoder : Decode.Decoder Reblog
reblogDecoder =
Decode.map Reblog (Decode.lazy (\_ -> statusDecoder))
statusDecoder : Decode.Decoder Status
statusDecoder =
Pipe.decode Status
|> Pipe.required "account" accountDecoder
|> Pipe.required "content" Decode.string
|> Pipe.required "created_at" Decode.string
|> Pipe.optional "favourited" (Decode.nullable Decode.bool) Nothing
|> Pipe.required "favourites_count" Decode.int
|> Pipe.required "id" Decode.int
|> Pipe.required "in_reply_to_account_id" (Decode.nullable Decode.int)
|> Pipe.required "in_reply_to_id" (Decode.nullable Decode.int)
|> Pipe.required "media_attachments" (Decode.list attachmentDecoder)
|> Pipe.required "mentions" (Decode.list mentionDecoder)
|> Pipe.optional "reblog" (Decode.lazy (\_ -> Decode.nullable reblogDecoder)) Nothing
|> Pipe.optional "reblogged" (Decode.nullable Decode.bool) Nothing
|> Pipe.required "reblogs_count" Decode.int
|> Pipe.required "sensitive" (Decode.nullable Decode.bool)
|> Pipe.required "spoiler_text" Decode.string
|> Pipe.required "tags" (Decode.list tagDecoder)
|> Pipe.required "uri" Decode.string
|> Pipe.required "url" Decode.string
|> Pipe.required "visibility" Decode.string
webSocketPayloadDecoder : Decode.Decoder WebSocketPayload
webSocketPayloadDecoder =
Decode.oneOf
[ Decode.map StringPayload Decode.string
, Decode.map IntPayload Decode.int
]
webSocketEventDecoder : Decode.Decoder WebSocketMessage
webSocketEventDecoder =
Pipe.decode WebSocketMessage
|> Pipe.required "event" Decode.string
|> Pipe.required "payload" webSocketPayloadDecoder
decodeWebSocketMessage : String -> WebSocketEvent
decodeWebSocketMessage message =
case (Decode.decodeString webSocketEventDecoder message) of
Ok message ->
case message.event of
"update" ->
case message.payload of
StringPayload payload ->
StatusUpdateEvent (Decode.decodeString statusDecoder payload)
_ ->
ErrorEvent "WS status update event payload must be a string"
"delete" ->
case message.payload of
IntPayload payload ->
StatusDeleteEvent <| Ok payload
_ ->
ErrorEvent "WS status delete event payload must be an int"
"notification" ->
case message.payload of
StringPayload payload ->
NotificationEvent (Decode.decodeString notificationDecoder payload)
_ ->
ErrorEvent "WS notification event payload must be an string"
event ->
ErrorEvent <| "Unknown WS event " ++ event
Err error ->
ErrorEvent error

82
src/Mastodon/Encoder.elm Normal file
View File

@ -0,0 +1,82 @@
module Mastodon.Encoder
exposing
( encodeUrl
, appRegistrationEncoder
, authorizationCodeEncoder
, clientEncoder
, registrationEncoder
, statusRequestBodyEncoder
)
import Http
import Json.Encode as Encode
import Mastodon.Model exposing (..)
encodeMaybe : (a -> Encode.Value) -> Maybe a -> Encode.Value
encodeMaybe encode thing =
case thing of
Nothing ->
Encode.null
Just value ->
encode value
encodeUrl : String -> List ( String, String ) -> String
encodeUrl base params =
List.map (\( k, v ) -> k ++ "=" ++ Http.encodeUri v) params
|> String.join "&"
|> (++) (base ++ "?")
appRegistrationEncoder : String -> String -> String -> String -> Encode.Value
appRegistrationEncoder client_name redirect_uris scope website =
Encode.object
[ ( "client_name", Encode.string client_name )
, ( "redirect_uris", Encode.string redirect_uris )
, ( "scopes", Encode.string scope )
, ( "website", Encode.string website )
]
authorizationCodeEncoder : AppRegistration -> String -> Encode.Value
authorizationCodeEncoder registration authCode =
Encode.object
[ ( "client_id", Encode.string registration.client_id )
, ( "client_secret", Encode.string registration.client_secret )
, ( "grant_type", Encode.string "authorization_code" )
, ( "redirect_uri", Encode.string registration.redirect_uri )
, ( "code", Encode.string authCode )
]
clientEncoder : Client -> Encode.Value
clientEncoder client =
Encode.object
[ ( "server", Encode.string client.server )
, ( "token", Encode.string client.token )
]
registrationEncoder : AppRegistration -> Encode.Value
registrationEncoder registration =
Encode.object
[ ( "server", Encode.string registration.server )
, ( "scope", Encode.string registration.scope )
, ( "client_id", Encode.string registration.client_id )
, ( "client_secret", Encode.string registration.client_secret )
, ( "id", Encode.int registration.id )
, ( "redirect_uri", Encode.string registration.redirect_uri )
]
statusRequestBodyEncoder : StatusRequestBody -> Encode.Value
statusRequestBodyEncoder statusData =
Encode.object
[ ( "status", Encode.string statusData.status )
, ( "in_reply_to_id", encodeMaybe Encode.int statusData.in_reply_to_id )
, ( "spoiler_text", encodeMaybe Encode.string statusData.spoiler_text )
, ( "sensitive", Encode.bool statusData.sensitive )
, ( "visibility", Encode.string statusData.visibility )
]

141
src/Mastodon/Helper.elm Normal file
View File

@ -0,0 +1,141 @@
module Mastodon.Helper
exposing
( extractReblog
, aggregateNotifications
, addNotificationToAggregates
, notificationToAggregate
)
import List.Extra exposing (groupWhile)
import Mastodon.Model
exposing
( Notification
, NotificationAggregate
, Reblog(..)
, Status
)
extractReblog : Status -> Status
extractReblog status =
case status.reblog of
Just (Reblog reblog) ->
reblog
Nothing ->
status
notificationToAggregate : Notification -> NotificationAggregate
notificationToAggregate notification =
NotificationAggregate
notification.type_
notification.status
[ notification.account ]
notification.created_at
addNotificationToAggregates : Notification -> List NotificationAggregate -> List NotificationAggregate
addNotificationToAggregates notification aggregates =
let
addNewAccountToSameStatus : NotificationAggregate -> Notification -> NotificationAggregate
addNewAccountToSameStatus aggregate notification =
case ( aggregate.status, notification.status ) of
( Just aggregateStatus, Just notificationStatus ) ->
if aggregateStatus.id == notificationStatus.id then
{ aggregate | accounts = notification.account :: aggregate.accounts }
else
aggregate
( _, _ ) ->
aggregate
{-
Let's try to find an already existing aggregate, matching the notification
we are trying to add.
If we find any aggregate, we modify it inplace. If not, we return the
aggregates unmodified
-}
newAggregates =
aggregates
|> List.map
(\aggregate ->
case ( aggregate.type_, notification.type_ ) of
{-
Notification and aggregate are of the follow type.
Add the new following account.
-}
( "follow", "follow" ) ->
{ aggregate | accounts = notification.account :: aggregate.accounts }
{-
Notification is of type follow, but current aggregate
is of another type. Let's continue then.
-}
( _, "follow" ) ->
aggregate
{-
If both types are the same check if we should
add the new account.
-}
( aggregateType, notificationType ) ->
if aggregateType == notificationType then
addNewAccountToSameStatus aggregate notification
else
aggregate
)
in
{-
If we did no modification to the old aggregates it's
because we didn't found any match. So me have to create
a new aggregate
-}
if newAggregates == aggregates then
notificationToAggregate (notification) :: aggregates
else
newAggregates
aggregateNotifications : List Notification -> List NotificationAggregate
aggregateNotifications notifications =
let
only type_ notifications =
List.filter (\n -> n.type_ == type_) notifications
sameStatus n1 n2 =
case ( n1.status, n2.status ) of
( Just r1, Just r2 ) ->
r1.id == r2.id
_ ->
False
extractAggregate statusGroup =
let
accounts =
List.map .account statusGroup
in
case statusGroup of
notification :: _ ->
[ NotificationAggregate
notification.type_
notification.status
accounts
notification.created_at
]
[] ->
[]
aggregate statusGroups =
List.map extractAggregate statusGroups |> List.concat
in
[ notifications |> only "reblog" |> groupWhile sameStatus |> aggregate
, notifications |> only "favourite" |> groupWhile sameStatus |> aggregate
, notifications |> only "mention" |> groupWhile sameStatus |> aggregate
, notifications |> only "follow" |> groupWhile (\_ _ -> True) |> aggregate
]
|> List.concat
|> List.sortBy .created_at
|> List.reverse

161
src/Mastodon/Http.elm Normal file
View File

@ -0,0 +1,161 @@
module Mastodon.Http
exposing
( Request
, reblog
, unreblog
, favourite
, unfavourite
, register
, getAuthorizationUrl
, getAccessToken
, fetchAccount
, fetchLocalTimeline
, fetchNotifications
, fetchGlobalTimeline
, fetchUserTimeline
, postStatus
, send
)
import Http
import HttpBuilder
import Json.Decode as Decode
import Mastodon.ApiUrl as ApiUrl
import Mastodon.Decoder exposing (..)
import Mastodon.Encoder exposing (..)
import Mastodon.Model exposing (..)
type alias Request a =
HttpBuilder.RequestBuilder a
extractMastodonError : Int -> String -> String -> Error
extractMastodonError statusCode statusMsg body =
case Decode.decodeString mastodonErrorDecoder body of
Ok errRecord ->
MastodonError statusCode statusMsg errRecord
Err err ->
ServerError statusCode statusMsg err
extractError : Http.Error -> Error
extractError error =
case error of
Http.BadStatus { status, body } ->
extractMastodonError status.code status.message body
Http.BadPayload str { status } ->
ServerError
status.code
status.message
("Failed decoding JSON: " ++ str)
Http.Timeout ->
TimeoutError
_ ->
NetworkError
toResponse : Result Http.Error a -> Result Error a
toResponse result =
Result.mapError extractError result
fetch : Client -> String -> Decode.Decoder a -> Request a
fetch client endpoint decoder =
HttpBuilder.get (client.server ++ endpoint)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson decoder)
register : String -> String -> String -> String -> String -> Request AppRegistration
register server client_name redirect_uri scope website =
HttpBuilder.post (ApiUrl.apps server)
|> HttpBuilder.withExpect (Http.expectJson (appRegistrationDecoder server scope))
|> HttpBuilder.withJsonBody (appRegistrationEncoder client_name redirect_uri scope website)
getAuthorizationUrl : AppRegistration -> String
getAuthorizationUrl registration =
encodeUrl (ApiUrl.oauthAuthorize registration.server)
[ ( "response_type", "code" )
, ( "client_id", registration.client_id )
, ( "scope", registration.scope )
, ( "redirect_uri", registration.redirect_uri )
]
getAccessToken : AppRegistration -> String -> Request AccessTokenResult
getAccessToken registration authCode =
HttpBuilder.post (ApiUrl.oauthToken registration.server)
|> HttpBuilder.withExpect (Http.expectJson (accessTokenDecoder registration))
|> HttpBuilder.withJsonBody (authorizationCodeEncoder registration authCode)
send : (Result Error a -> msg) -> Request a -> Cmd msg
send tagger builder =
builder |> HttpBuilder.send (toResponse >> tagger)
fetchAccount : Client -> Int -> Request Account
fetchAccount client accountId =
fetch client (ApiUrl.account accountId) accountDecoder
fetchUserTimeline : Client -> Request (List Status)
fetchUserTimeline client =
fetch client ApiUrl.homeTimeline <| Decode.list statusDecoder
fetchLocalTimeline : Client -> Request (List Status)
fetchLocalTimeline client =
fetch client (ApiUrl.publicTimeline (Just "public")) <| Decode.list statusDecoder
fetchGlobalTimeline : Client -> Request (List Status)
fetchGlobalTimeline client =
fetch client (ApiUrl.publicTimeline (Nothing)) <| Decode.list statusDecoder
fetchNotifications : Client -> Request (List Notification)
fetchNotifications client =
fetch client (ApiUrl.notifications) <| Decode.list notificationDecoder
postStatus : Client -> StatusRequestBody -> Request Status
postStatus client statusRequestBody =
HttpBuilder.post (ApiUrl.statuses client.server)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
|> HttpBuilder.withJsonBody (statusRequestBodyEncoder statusRequestBody)
reblog : Client -> Int -> Request Status
reblog client id =
HttpBuilder.post (ApiUrl.reblog client.server id)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
unreblog : Client -> Int -> Request Status
unreblog client id =
HttpBuilder.post (ApiUrl.unreblog client.server id)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
favourite : Client -> Int -> Request Status
favourite client id =
HttpBuilder.post (ApiUrl.favourite client.server id)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
unfavourite : Client -> Int -> Request Status
unfavourite client id =
HttpBuilder.post (ApiUrl.unfavourite client.server id)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)

187
src/Mastodon/Model.elm Normal file
View File

@ -0,0 +1,187 @@
module Mastodon.Model
exposing
( AccessTokenResult
, AppRegistration
, Account
, Attachment
, Client
, Error(..)
, Mention
, Notification
, NotificationAggregate
, Reblog(..)
, Tag
, Status
, StatusRequestBody
)
import HttpBuilder
type alias AccountId =
Int
type alias AuthCode =
String
type alias ClientId =
String
type alias ClientSecret =
String
type alias Server =
String
type alias StatusCode =
Int
type alias StatusMsg =
String
type alias Token =
String
type Error
= MastodonError StatusCode StatusMsg String
| ServerError StatusCode StatusMsg String
| TimeoutError
| NetworkError
type alias AccessTokenResult =
{ server : Server
, accessToken : Token
}
type alias AppRegistration =
{ server : Server
, scope : String
, client_id : ClientId
, client_secret : ClientSecret
, id : Int
, redirect_uri : String
}
type alias Account =
{ acct : String
, avatar : String
, created_at : String
, display_name : String
, followers_count : Int
, following_count : Int
, header : String
, id : AccountId
, locked : Bool
, note : String
, statuses_count : Int
, url : String
, username : String
}
type alias Attachment =
-- type_: -- "image", "video", "gifv"
{ id : Int
, type_ : String
, url : String
, remote_url : String
, preview_url : String
, text_url : Maybe String
}
type alias Client =
{ server : Server
, token : Token
}
type alias Mention =
{ id : AccountId
, url : String
, username : String
, acct : String
}
type alias Notification =
{-
- id: The notification ID
- type_: One of: "mention", "reblog", "favourite", "follow"
- created_at: The time the notification was created
- account: The Account sending the notification to the user
- status: The Status associated with the notification, if applicable
-}
{ id : Int
, type_ : String
, created_at : String
, account : Account
, status : Maybe Status
}
type alias NotificationAggregate =
{ type_ : String
, status : Maybe Status
, accounts : List Account
, created_at : String
}
type Reblog
= Reblog Status
type alias Status =
{ account : Account
, content : String
, created_at : String
, favourited : Maybe Bool
, favourites_count : Int
, id : Int
, in_reply_to_account_id : Maybe Int
, in_reply_to_id : Maybe Int
, media_attachments : List Attachment
, mentions : List Mention
, reblog : Maybe Reblog
, reblogged : Maybe Bool
, reblogs_count : Int
, sensitive : Maybe Bool
, spoiler_text : String
, tags : List Tag
, uri : String
, url : String
, visibility : String
}
type alias StatusRequestBody =
-- status: The text of the status
-- in_reply_to_id: local ID of the status you want to reply to
-- sensitive: set this to mark the media of the status as NSFW
-- spoiler_text: text to be shown as a warning before the actual content
-- visibility: either "direct", "private", "unlisted" or "public"
-- TODO: media_ids: array of media IDs to attach to the status (maximum 4)
{ status : String
, in_reply_to_id : Maybe Int
, spoiler_text : Maybe String
, sensitive : Bool
, visibility : String
}
type alias Tag =
{ name : String
, url : String
}

62
src/Mastodon/WebSocket.elm Normal file
View File

@ -0,0 +1,62 @@
module Mastodon.WebSocket
exposing
( StreamType(..)
, WebSocketEvent(..)
, WebSocketMessage
, WebSocketPayload(..)
, subscribeToWebSockets
)
import String.Extra exposing (replaceSlice)
import WebSocket
import Mastodon.ApiUrl as ApiUrl
import Mastodon.Encoder exposing (encodeUrl)
import Mastodon.Model exposing (..)
type StreamType
= UserStream
| LocalPublicStream
| GlobalPublicStream
type WebSocketEvent
= StatusUpdateEvent (Result String Status)
| NotificationEvent (Result String Notification)
| StatusDeleteEvent (Result String Int)
| ErrorEvent String
type WebSocketPayload
= StringPayload String
| IntPayload Int
type alias WebSocketMessage =
{ event : String
, payload : WebSocketPayload
}
subscribeToWebSockets : Client -> StreamType -> (String -> a) -> Sub a
subscribeToWebSockets client streamType message =
let
type_ =
case streamType of
GlobalPublicStream ->
"public"
LocalPublicStream ->
"public:local"
UserStream ->
"user"
url =
encodeUrl
(ApiUrl.streaming (replaceSlice "wss" 0 5 client.server))
[ ( "access_token", client.token )
, ( "stream", type_ )
]
in
WebSocket.listen url message

194
src/Model.elm
View File

@ -3,14 +3,19 @@ module Model exposing (..)
import Dom import Dom
import Json.Encode as Encode import Json.Encode as Encode
import Navigation import Navigation
import Mastodon import Mastodon.Decoder
import Mastodon.Encoder
import Mastodon.Helper
import Mastodon.Http
import Mastodon.Model
import Mastodon.WebSocket
import Ports import Ports
import Task import Task
type alias Flags = type alias Flags =
{ client : Maybe Mastodon.Client { client : Maybe Mastodon.Model.Client
, registration : Maybe Mastodon.AppRegistration , registration : Maybe Mastodon.Model.AppRegistration
} }
@ -21,28 +26,28 @@ type DraftMsg
| UpdateSpoiler String | UpdateSpoiler String
| UpdateStatus String | UpdateStatus String
| UpdateVisibility String | UpdateVisibility String
| UpdateReplyTo Mastodon.Status | UpdateReplyTo Mastodon.Model.Status
| ToggleSpoiler Bool | ToggleSpoiler Bool
type ViewerMsg type ViewerMsg
= CloseViewer = CloseViewer
| OpenViewer (List Mastodon.Attachment) Mastodon.Attachment | OpenViewer (List Mastodon.Model.Attachment) Mastodon.Model.Attachment
type MastodonMsg type MastodonMsg
= AccessToken (Result Mastodon.Error Mastodon.AccessTokenResult) = AccessToken (Result Mastodon.Model.Error Mastodon.Model.AccessTokenResult)
| AppRegistered (Result Mastodon.Error Mastodon.AppRegistration) | AppRegistered (Result Mastodon.Model.Error Mastodon.Model.AppRegistration)
| FavoriteAdded (Result Mastodon.Error Mastodon.Status) | FavoriteAdded (Result Mastodon.Model.Error Mastodon.Model.Status)
| FavoriteRemoved (Result Mastodon.Error Mastodon.Status) | FavoriteRemoved (Result Mastodon.Model.Error Mastodon.Model.Status)
| LocalTimeline (Result Mastodon.Error (List Mastodon.Status)) | LocalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
| Notifications (Result Mastodon.Error (List Mastodon.Notification)) | Notifications (Result Mastodon.Model.Error (List Mastodon.Model.Notification))
| GlobalTimeline (Result Mastodon.Error (List Mastodon.Status)) | GlobalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
| Reblogged (Result Mastodon.Error Mastodon.Status) | Reblogged (Result Mastodon.Model.Error Mastodon.Model.Status)
| StatusPosted (Result Mastodon.Error Mastodon.Status) | StatusPosted (Result Mastodon.Model.Error Mastodon.Model.Status)
| Unreblogged (Result Mastodon.Error Mastodon.Status) | Unreblogged (Result Mastodon.Model.Error Mastodon.Model.Status)
| UserAccount (Result Mastodon.Error Mastodon.Account) | UserAccount (Result Mastodon.Model.Error Mastodon.Model.Account)
| UserTimeline (Result Mastodon.Error (List Mastodon.Status)) | UserTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
type WebSocketMsg type WebSocketMsg
@ -72,7 +77,7 @@ type Msg
type alias Draft = type alias Draft =
{ status : String { status : String
, in_reply_to : Maybe Mastodon.Status , in_reply_to : Maybe Mastodon.Model.Status
, spoiler_text : Maybe String , spoiler_text : Maybe String
, sensitive : Bool , sensitive : Bool
, visibility : String , visibility : String
@ -80,21 +85,21 @@ type alias Draft =
type alias Viewer = type alias Viewer =
{ attachments : List Mastodon.Attachment { attachments : List Mastodon.Model.Attachment
, attachment : Mastodon.Attachment , attachment : Mastodon.Model.Attachment
} }
type alias Model = type alias Model =
{ server : String { server : String
, registration : Maybe Mastodon.AppRegistration , registration : Maybe Mastodon.Model.AppRegistration
, client : Maybe Mastodon.Client , client : Maybe Mastodon.Model.Client
, userTimeline : List Mastodon.Status , userTimeline : List Mastodon.Model.Status
, localTimeline : List Mastodon.Status , localTimeline : List Mastodon.Model.Status
, globalTimeline : List Mastodon.Status , globalTimeline : List Mastodon.Model.Status
, notifications : List Mastodon.NotificationAggregate , notifications : List Mastodon.Model.NotificationAggregate
, draft : Draft , draft : Draft
, account : Maybe Mastodon.Account , account : Maybe Mastodon.Model.Account
, errors : List String , errors : List String
, location : Navigation.Location , location : Navigation.Location
, useGlobalTimeline : Bool , useGlobalTimeline : Bool
@ -145,15 +150,15 @@ init flags location =
! [ initCommands flags.registration flags.client authCode ] ! [ initCommands flags.registration flags.client authCode ]
initCommands : Maybe Mastodon.AppRegistration -> Maybe Mastodon.Client -> Maybe String -> Cmd Msg initCommands : Maybe Mastodon.Model.AppRegistration -> Maybe Mastodon.Model.Client -> Maybe String -> Cmd Msg
initCommands registration client authCode = initCommands registration client authCode =
Cmd.batch <| Cmd.batch <|
case authCode of case authCode of
Just authCode -> Just authCode ->
case registration of case registration of
Just registration -> Just registration ->
[ Mastodon.getAccessToken registration authCode [ Mastodon.Http.getAccessToken registration authCode
|> Mastodon.send (MastodonEvent << AccessToken) |> Mastodon.Http.send (MastodonEvent << AccessToken)
] ]
Nothing -> Nothing ->
@ -175,48 +180,51 @@ registerApp { server, location } =
else else
server server
in in
Mastodon.register Mastodon.Http.register
cleanServer cleanServer
"tooty" "tooty"
appUrl appUrl
"read write follow" "read write follow"
"https://github.com/n1k0/tooty" "https://github.com/n1k0/tooty"
|> Mastodon.send (MastodonEvent << AppRegistered) |> Mastodon.Http.send (MastodonEvent << AppRegistered)
saveClient : Mastodon.Client -> Cmd Msg saveClient : Mastodon.Model.Client -> Cmd Msg
saveClient client = saveClient client =
Mastodon.clientEncoder client Mastodon.Encoder.clientEncoder client
|> Encode.encode 0 |> Encode.encode 0
|> Ports.saveClient |> Ports.saveClient
saveRegistration : Mastodon.AppRegistration -> Cmd Msg saveRegistration : Mastodon.Model.AppRegistration -> Cmd Msg
saveRegistration registration = saveRegistration registration =
Mastodon.registrationEncoder registration Mastodon.Encoder.registrationEncoder registration
|> Encode.encode 0 |> Encode.encode 0
|> Ports.saveRegistration |> Ports.saveRegistration
loadNotifications : Maybe Mastodon.Client -> Cmd Msg loadNotifications : Maybe Mastodon.Model.Client -> Cmd Msg
loadNotifications client = loadNotifications client =
case client of case client of
Just client -> Just client ->
Mastodon.fetchNotifications client Mastodon.Http.fetchNotifications client
|> Mastodon.send (MastodonEvent << Notifications) |> Mastodon.Http.send (MastodonEvent << Notifications)
Nothing -> Nothing ->
Cmd.none Cmd.none
loadTimelines : Maybe Mastodon.Client -> Cmd Msg loadTimelines : Maybe Mastodon.Model.Client -> Cmd Msg
loadTimelines client = loadTimelines client =
case client of case client of
Just client -> Just client ->
Cmd.batch Cmd.batch
[ Mastodon.fetchUserTimeline client |> Mastodon.send (MastodonEvent << UserTimeline) [ Mastodon.Http.fetchUserTimeline client
, Mastodon.fetchLocalTimeline client |> Mastodon.send (MastodonEvent << LocalTimeline) |> Mastodon.Http.send (MastodonEvent << UserTimeline)
, Mastodon.fetchGlobalTimeline client |> Mastodon.send (MastodonEvent << GlobalTimeline) , Mastodon.Http.fetchLocalTimeline client
|> Mastodon.Http.send (MastodonEvent << LocalTimeline)
, Mastodon.Http.fetchGlobalTimeline client
|> Mastodon.Http.send (MastodonEvent << GlobalTimeline)
, loadNotifications <| Just client , loadNotifications <| Just client
] ]
@ -224,29 +232,29 @@ loadTimelines client =
Cmd.none Cmd.none
postStatus : Mastodon.Client -> Mastodon.StatusRequestBody -> Cmd Msg postStatus : Mastodon.Model.Client -> Mastodon.Model.StatusRequestBody -> Cmd Msg
postStatus client draft = postStatus client draft =
Mastodon.postStatus client draft Mastodon.Http.postStatus client draft
|> Mastodon.send (MastodonEvent << StatusPosted) |> Mastodon.Http.send (MastodonEvent << StatusPosted)
errorText : Mastodon.Error -> String errorText : Mastodon.Model.Error -> String
errorText error = errorText error =
case error of case error of
Mastodon.MastodonError statusCode statusMsg errorMsg -> Mastodon.Model.MastodonError statusCode statusMsg errorMsg ->
"HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg
Mastodon.ServerError statusCode statusMsg errorMsg -> Mastodon.Model.ServerError statusCode statusMsg errorMsg ->
"HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg
Mastodon.TimeoutError -> Mastodon.Model.TimeoutError ->
"Request timed out." "Request timed out."
Mastodon.NetworkError -> Mastodon.Model.NetworkError ->
"Unreachable host." "Unreachable host."
toStatusRequestBody : Draft -> Mastodon.StatusRequestBody toStatusRequestBody : Draft -> Mastodon.Model.StatusRequestBody
toStatusRequestBody draft = toStatusRequestBody draft =
{ status = draft.status { status = draft.status
, in_reply_to_id = , in_reply_to_id =
@ -262,11 +270,11 @@ toStatusRequestBody draft =
} }
updateTimelinesWithBoolFlag : Int -> Bool -> (Mastodon.Status -> Mastodon.Status) -> Model -> Model updateTimelinesWithBoolFlag : Int -> Bool -> (Mastodon.Model.Status -> Mastodon.Model.Status) -> Model -> Model
updateTimelinesWithBoolFlag statusId flag statusUpdater model = updateTimelinesWithBoolFlag statusId flag statusUpdater model =
let let
update flag status = update flag status =
if (Mastodon.extractReblog status).id == statusId then if (Mastodon.Helper.extractReblog status).id == statusId then
statusUpdater status statusUpdater status
else else
status status
@ -288,10 +296,16 @@ processReblog statusId flag model =
updateTimelinesWithBoolFlag statusId flag (\s -> { s | reblogged = Just flag }) model updateTimelinesWithBoolFlag statusId flag (\s -> { s | reblogged = Just flag }) model
deleteStatusFromTimeline : Int -> List Mastodon.Status -> List Mastodon.Status deleteStatusFromTimeline : Int -> List Mastodon.Model.Status -> List Mastodon.Model.Status
deleteStatusFromTimeline statusId timeline = deleteStatusFromTimeline statusId timeline =
timeline timeline
|> List.filter (\s -> s.id /= statusId && (Mastodon.extractReblog s).id /= statusId) |> List.filter
(\s ->
s.id
/= statusId
&& (Mastodon.Helper.extractReblog s).id
/= statusId
)
updateDraft : DraftMsg -> Draft -> ( Draft, Cmd Msg ) updateDraft : DraftMsg -> Draft -> ( Draft, Cmd Msg )
@ -366,7 +380,7 @@ processMastodonEvent msg model =
Ok { server, accessToken } -> Ok { server, accessToken } ->
let let
client = client =
Mastodon.Client server accessToken Mastodon.Model.Client server accessToken
in in
{ model | client = Just client } { model | client = Just client }
! [ loadTimelines <| Just client ! [ loadTimelines <| Just client
@ -382,7 +396,7 @@ processMastodonEvent msg model =
Ok registration -> Ok registration ->
{ model | registration = Just registration } { model | registration = Just registration }
! [ saveRegistration registration ! [ saveRegistration registration
, Navigation.load <| Mastodon.getAuthorizationUrl registration , Navigation.load <| Mastodon.Http.getAuthorizationUrl registration
] ]
Err error -> Err error ->
@ -415,7 +429,7 @@ processMastodonEvent msg model =
Notifications result -> Notifications result ->
case result of case result of
Ok notifications -> Ok notifications ->
{ model | notifications = Mastodon.aggregateNotifications notifications } ! [] { model | notifications = Mastodon.Helper.aggregateNotifications notifications } ! []
Err error -> Err error ->
{ model | notifications = [], errors = (errorText error) :: model.errors } ! [] { model | notifications = [], errors = (errorText error) :: model.errors } ! []
@ -468,11 +482,11 @@ processWebSocketMsg : WebSocketMsg -> Model -> ( Model, Cmd Msg )
processWebSocketMsg msg model = processWebSocketMsg msg model =
case msg of case msg of
NewWebsocketUserMessage message -> NewWebsocketUserMessage message ->
case (Mastodon.decodeWebSocketMessage message) of case (Mastodon.Decoder.decodeWebSocketMessage message) of
Mastodon.ErrorEvent error -> Mastodon.WebSocket.ErrorEvent error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
Mastodon.StatusUpdateEvent result -> Mastodon.WebSocket.StatusUpdateEvent result ->
case result of case result of
Ok status -> Ok status ->
{ model | userTimeline = status :: model.userTimeline } ! [] { model | userTimeline = status :: model.userTimeline } ! []
@ -480,7 +494,7 @@ processWebSocketMsg msg model =
Err error -> Err error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
Mastodon.StatusDeleteEvent result -> Mastodon.WebSocket.StatusDeleteEvent result ->
case result of case result of
Ok id -> Ok id ->
{ model | userTimeline = deleteStatusFromTimeline id model.userTimeline } ! [] { model | userTimeline = deleteStatusFromTimeline id model.userTimeline } ! []
@ -488,12 +502,14 @@ processWebSocketMsg msg model =
Err error -> Err error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
Mastodon.NotificationEvent result -> Mastodon.WebSocket.NotificationEvent result ->
case result of case result of
Ok notification -> Ok notification ->
let let
notifications = notifications =
Mastodon.addNotificationToAggregates notification model.notifications Mastodon.Helper.addNotificationToAggregates
notification
model.notifications
in in
{ model | notifications = notifications } ! [] { model | notifications = notifications } ! []
@ -501,11 +517,11 @@ processWebSocketMsg msg model =
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
NewWebsocketLocalMessage message -> NewWebsocketLocalMessage message ->
case (Mastodon.decodeWebSocketMessage message) of case (Mastodon.Decoder.decodeWebSocketMessage message) of
Mastodon.ErrorEvent error -> Mastodon.WebSocket.ErrorEvent error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
Mastodon.StatusUpdateEvent result -> Mastodon.WebSocket.StatusUpdateEvent result ->
case result of case result of
Ok status -> Ok status ->
{ model | localTimeline = status :: model.localTimeline } ! [] { model | localTimeline = status :: model.localTimeline } ! []
@ -513,7 +529,7 @@ processWebSocketMsg msg model =
Err error -> Err error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
Mastodon.StatusDeleteEvent result -> Mastodon.WebSocket.StatusDeleteEvent result ->
case result of case result of
Ok id -> Ok id ->
{ model | localTimeline = deleteStatusFromTimeline id model.localTimeline } ! [] { model | localTimeline = deleteStatusFromTimeline id model.localTimeline } ! []
@ -525,11 +541,11 @@ processWebSocketMsg msg model =
model ! [] model ! []
NewWebsocketGlobalMessage message -> NewWebsocketGlobalMessage message ->
case (Mastodon.decodeWebSocketMessage message) of case (Mastodon.Decoder.decodeWebSocketMessage message) of
Mastodon.ErrorEvent error -> Mastodon.WebSocket.ErrorEvent error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
Mastodon.StatusUpdateEvent result -> Mastodon.WebSocket.StatusUpdateEvent result ->
case result of case result of
Ok status -> Ok status ->
{ model | globalTimeline = status :: model.globalTimeline } ! [] { model | globalTimeline = status :: model.globalTimeline } ! []
@ -537,7 +553,7 @@ processWebSocketMsg msg model =
Err error -> Err error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
Mastodon.StatusDeleteEvent result -> Mastodon.WebSocket.StatusDeleteEvent result ->
case result of case result of
Ok id -> Ok id ->
{ model | globalTimeline = deleteStatusFromTimeline id model.globalTimeline } ! [] { model | globalTimeline = deleteStatusFromTimeline id model.globalTimeline } ! []
@ -585,8 +601,8 @@ update msg model =
case model.client of case model.client of
Just client -> Just client ->
processReblog id True model processReblog id True model
! [ Mastodon.reblog client id ! [ Mastodon.Http.reblog client id
|> Mastodon.send (MastodonEvent << Reblogged) |> Mastodon.Http.send (MastodonEvent << Reblogged)
] ]
Nothing -> Nothing ->
@ -596,8 +612,8 @@ update msg model =
case model.client of case model.client of
Just client -> Just client ->
processReblog id False model processReblog id False model
! [ Mastodon.unfavourite client id ! [ Mastodon.Http.unfavourite client id
|> Mastodon.send (MastodonEvent << Unreblogged) |> Mastodon.Http.send (MastodonEvent << Unreblogged)
] ]
Nothing -> Nothing ->
@ -607,8 +623,8 @@ update msg model =
model model
! case model.client of ! case model.client of
Just client -> Just client ->
[ Mastodon.favourite client id [ Mastodon.Http.favourite client id
|> Mastodon.send (MastodonEvent << FavoriteAdded) |> Mastodon.Http.send (MastodonEvent << FavoriteAdded)
] ]
Nothing -> Nothing ->
@ -618,8 +634,8 @@ update msg model =
model model
! case model.client of ! case model.client of
Just client -> Just client ->
[ Mastodon.unfavourite client id [ Mastodon.Http.unfavourite client id
|> Mastodon.send (MastodonEvent << FavoriteRemoved) |> Mastodon.Http.send (MastodonEvent << FavoriteRemoved)
] ]
Nothing -> Nothing ->
@ -657,8 +673,8 @@ update msg model =
model model
! case model.client of ! case model.client of
Just client -> Just client ->
[ Mastodon.fetchAccount client accountId [ Mastodon.Http.fetchAccount client accountId
|> Mastodon.send (MastodonEvent << UserAccount) |> Mastodon.Http.send (MastodonEvent << UserAccount)
] ]
Nothing -> Nothing ->
@ -677,21 +693,21 @@ subscriptions model =
Just client -> Just client ->
let let
subs = subs =
[ Mastodon.subscribeToWebSockets [ Mastodon.WebSocket.subscribeToWebSockets
client client
Mastodon.UserStream Mastodon.WebSocket.UserStream
NewWebsocketUserMessage NewWebsocketUserMessage
] ]
++ (if model.useGlobalTimeline then ++ (if model.useGlobalTimeline then
[ Mastodon.subscribeToWebSockets [ Mastodon.WebSocket.subscribeToWebSockets
client client
Mastodon.GlobalPublicStream Mastodon.WebSocket.GlobalPublicStream
NewWebsocketGlobalMessage NewWebsocketGlobalMessage
] ]
else else
[ Mastodon.subscribeToWebSockets [ Mastodon.WebSocket.subscribeToWebSockets
client client
Mastodon.LocalPublicStream Mastodon.WebSocket.LocalPublicStream
NewWebsocketLocalMessage NewWebsocketLocalMessage
] ]
) )

6
src/Util.elm
View File

@ -1,6 +0,0 @@
module Util exposing (..)
replace : String -> String -> String -> String
replace from to str =
String.split from str |> String.join to

44
src/View.elm
View File

@ -5,7 +5,8 @@ import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import List.Extra exposing (elemIndex, getAt) import List.Extra exposing (elemIndex, getAt)
import Mastodon import Mastodon.Helper
import Mastodon.Model
import Model exposing (Model, Draft, DraftMsg(..), Viewer, ViewerMsg(..), Msg(..)) import Model exposing (Model, Draft, DraftMsg(..), Viewer, ViewerMsg(..), Msg(..))
import ViewHelper import ViewHelper
import Date import Date
@ -49,7 +50,7 @@ icon name =
i [ class <| "glyphicon glyphicon-" ++ name ] [] i [ class <| "glyphicon glyphicon-" ++ name ] []
accountLink : Mastodon.Account -> Html Msg accountLink : Mastodon.Model.Account -> Html Msg
accountLink account = accountLink account =
a a
[ href account.url [ href account.url
@ -58,7 +59,7 @@ accountLink account =
[ text <| "@" ++ account.username ] [ text <| "@" ++ account.username ]
accountAvatarLink : Mastodon.Account -> Html Msg accountAvatarLink : Mastodon.Model.Account -> Html Msg
accountAvatarLink account = accountAvatarLink account =
a a
[ href account.url [ href account.url
@ -68,7 +69,7 @@ accountAvatarLink account =
[ img [ class "avatar", src account.avatar ] [] ] [ img [ class "avatar", src account.avatar ] [] ]
attachmentPreview : String -> Maybe Bool -> List Mastodon.Attachment -> Mastodon.Attachment -> Html Msg attachmentPreview : String -> Maybe Bool -> List Mastodon.Model.Attachment -> Mastodon.Model.Attachment -> Html Msg
attachmentPreview context sensitive attachments ({ url, preview_url } as attachment) = attachmentPreview context sensitive attachments ({ url, preview_url } as attachment) =
let let
nsfw = nsfw =
@ -111,7 +112,7 @@ attachmentPreview context sensitive attachments ({ url, preview_url } as attachm
[ media ] [ media ]
attachmentListView : String -> Mastodon.Status -> Html Msg attachmentListView : String -> Mastodon.Model.Status -> Html Msg
attachmentListView context { media_attachments, sensitive } = attachmentListView context { media_attachments, sensitive } =
case media_attachments of case media_attachments of
[] -> [] ->
@ -122,7 +123,7 @@ attachmentListView context { media_attachments, sensitive } =
List.map (attachmentPreview context sensitive attachments) attachments List.map (attachmentPreview context sensitive attachments) attachments
statusContentView : String -> Mastodon.Status -> Html Msg statusContentView : String -> Mastodon.Model.Status -> Html Msg
statusContentView context status = statusContentView context status =
case status.spoiler_text of case status.spoiler_text of
"" -> "" ->
@ -148,19 +149,20 @@ statusContentView context status =
] ]
statusView : String -> Mastodon.Status -> Html Msg statusView : String -> Mastodon.Model.Status -> Html Msg
statusView context ({ account, content, media_attachments, reblog, mentions } as status) = statusView context ({ account, content, media_attachments, reblog, mentions } as status) =
let let
accountLinkAttributes = accountLinkAttributes =
[ href account.url [ href account.url
-- When clicking on a status, we should not let the browser
-- redirect to a new page. That's why we're preventing the default -- When clicking on a status, we should not let the browser
-- behavior here -- redirect to a new page. That's why we're preventing the default
-- behavior here
, ViewHelper.onClickWithPreventAndStop (OnLoadUserAccount account.id) , ViewHelper.onClickWithPreventAndStop (OnLoadUserAccount account.id)
] ]
in in
case reblog of case reblog of
Just (Mastodon.Reblog reblog) -> Just (Mastodon.Model.Reblog reblog) ->
div [ class "reblog" ] div [ class "reblog" ]
[ p [ class "status-info" ] [ p [ class "status-info" ]
[ icon "fire" [ icon "fire"
@ -184,7 +186,7 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as
] ]
accountTimelineView : Mastodon.Account -> List Mastodon.Status -> String -> String -> Html Msg accountTimelineView : Mastodon.Model.Account -> List Mastodon.Model.Status -> String -> String -> Html Msg
accountTimelineView account statuses label iconName = accountTimelineView account statuses label iconName =
div [ class "col-md-3" ] div [ class "col-md-3" ]
[ div [ class "panel panel-default" ] [ div [ class "panel panel-default" ]
@ -236,11 +238,11 @@ accountTimelineView account statuses label iconName =
] ]
statusActionsView : Mastodon.Status -> Html Msg statusActionsView : Mastodon.Model.Status -> Html Msg
statusActionsView status = statusActionsView status =
let let
targetStatus = targetStatus =
Mastodon.extractReblog status Mastodon.Helper.extractReblog status
baseBtnClasses = baseBtnClasses =
"btn btn-sm btn-default" "btn btn-sm btn-default"
@ -294,7 +296,7 @@ statusActionsView status =
] ]
statusEntryView : String -> Mastodon.Status -> Html Msg statusEntryView : String -> Mastodon.Model.Status -> Html Msg
statusEntryView context status = statusEntryView context status =
let let
nsfwClass = nsfwClass =
@ -311,7 +313,7 @@ statusEntryView context status =
] ]
timelineView : String -> String -> String -> List Mastodon.Status -> Html Msg timelineView : String -> String -> String -> List Mastodon.Model.Status -> Html Msg
timelineView label iconName context statuses = timelineView label iconName context statuses =
div [ class "col-md-3" ] div [ class "col-md-3" ]
[ div [ class "panel panel-default" ] [ div [ class "panel panel-default" ]
@ -325,7 +327,7 @@ timelineView label iconName context statuses =
] ]
notificationHeading : List Mastodon.Account -> String -> String -> Html Msg notificationHeading : List Mastodon.Model.Account -> String -> String -> Html Msg
notificationHeading accounts str iconType = notificationHeading accounts str iconType =
div [ class "status-info" ] div [ class "status-info" ]
[ div [ class "avatars" ] <| List.map accountAvatarLink accounts [ div [ class "avatars" ] <| List.map accountAvatarLink accounts
@ -338,7 +340,7 @@ notificationHeading accounts str iconType =
] ]
notificationStatusView : String -> Mastodon.Status -> Mastodon.NotificationAggregate -> Html Msg notificationStatusView : String -> Mastodon.Model.Status -> Mastodon.Model.NotificationAggregate -> Html Msg
notificationStatusView context status { type_, accounts } = notificationStatusView context status { type_, accounts } =
div [ class <| "notification " ++ type_ ] div [ class <| "notification " ++ type_ ]
[ case type_ of [ case type_ of
@ -355,7 +357,7 @@ notificationStatusView context status { type_, accounts } =
] ]
notificationFollowView : Mastodon.NotificationAggregate -> Html Msg notificationFollowView : Mastodon.Model.NotificationAggregate -> Html Msg
notificationFollowView { accounts } = notificationFollowView { accounts } =
let let
profileView account = profileView account =
@ -371,7 +373,7 @@ notificationFollowView { accounts } =
] ]
notificationEntryView : Mastodon.NotificationAggregate -> Html Msg notificationEntryView : Mastodon.Model.NotificationAggregate -> Html Msg
notificationEntryView notification = notificationEntryView notification =
li [ class "list-group-item" ] li [ class "list-group-item" ]
[ case notification.status of [ case notification.status of
@ -383,7 +385,7 @@ notificationEntryView notification =
] ]
notificationListView : List Mastodon.NotificationAggregate -> Html Msg notificationListView : List Mastodon.Model.NotificationAggregate -> Html Msg
notificationListView notifications = notificationListView notifications =
div [ class "col-md-3" ] div [ class "col-md-3" ]
[ div [ class "panel panel-default" ] [ div [ class "panel panel-default" ]

20
src/ViewHelper.elm
View File

@ -11,9 +11,9 @@ import Html.Attributes exposing (..)
import Html.Events exposing (onWithOptions) import Html.Events exposing (onWithOptions)
import HtmlParser import HtmlParser
import Json.Decode as Decode import Json.Decode as Decode
import Mastodon import String.Extra exposing (replace)
import Mastodon.Model
import Model exposing (Msg(OnLoadUserAccount)) import Model exposing (Msg(OnLoadUserAccount))
import Util
-- Custom Events -- Custom Events
@ -31,24 +31,24 @@ onClickWithPreventAndStop msg =
-- Views -- Views
formatContent : String -> List Mastodon.Mention -> List (Html Msg) formatContent : String -> List Mastodon.Model.Mention -> List (Html Msg)
formatContent content mentions = formatContent content mentions =
content content
|> Util.replace " ?" "&nbsp;?" |> replace " ?" "&nbsp;?"
|> Util.replace " !" "&nbsp;!" |> replace " !" "&nbsp;!"
|> Util.replace " :" "&nbsp;:" |> replace " :" "&nbsp;:"
|> HtmlParser.parse |> HtmlParser.parse
|> toVirtualDom mentions |> toVirtualDom mentions
{-| Converts nodes to virtual dom nodes. {-| Converts nodes to virtual dom nodes.
-} -}
toVirtualDom : List Mastodon.Mention -> List HtmlParser.Node -> List (Html Msg) toVirtualDom : List Mastodon.Model.Mention -> List HtmlParser.Node -> List (Html Msg)
toVirtualDom mentions nodes = toVirtualDom mentions nodes =
List.map (toVirtualDomEach mentions) nodes List.map (toVirtualDomEach mentions) nodes
createLinkNode : List ( String, String ) -> List HtmlParser.Node -> List Mastodon.Mention -> Html Msg createLinkNode : List ( String, String ) -> List HtmlParser.Node -> List Mastodon.Model.Mention -> Html Msg
createLinkNode attrs children mentions = createLinkNode attrs children mentions =
let let
maybeMention = maybeMention =
@ -76,7 +76,7 @@ getHrefLink attrs =
|> List.head |> List.head
getMentionForLink : List ( String, String ) -> List Mastodon.Mention -> Maybe Mastodon.Mention getMentionForLink : List ( String, String ) -> List Mastodon.Model.Mention -> Maybe Mastodon.Model.Mention
getMentionForLink attrs mentions = getMentionForLink attrs mentions =
case getHrefLink attrs of case getHrefLink attrs of
Just href -> Just href ->
@ -88,7 +88,7 @@ getMentionForLink attrs mentions =
Nothing Nothing
toVirtualDomEach : List Mastodon.Mention -> HtmlParser.Node -> Html Msg toVirtualDomEach : List Mastodon.Model.Mention -> HtmlParser.Node -> Html Msg
toVirtualDomEach mentions node = toVirtualDomEach mentions node =
case node of case node of
HtmlParser.Element "a" attrs children -> HtmlParser.Element "a" attrs children ->

2
tests/Fixtures.elm
View File

@ -1,6 +1,6 @@
module Fixtures exposing (..) module Fixtures exposing (..)
import Mastodon exposing (Account, Notification, NotificationAggregate, Status) import Mastodon.Model exposing (Account, Notification, NotificationAggregate, Status)
accountSkro : Account accountSkro : Account

4
tests/Main.elm
View File

@ -1,13 +1,13 @@
port module Main exposing (..) port module Main exposing (..)
import NotificationTests import MastodonTest.HelperTest
import Test.Runner.Node exposing (run, TestProgram) import Test.Runner.Node exposing (run, TestProgram)
import Json.Encode exposing (Value) import Json.Encode exposing (Value)
main : TestProgram main : TestProgram
main = main =
run emit NotificationTests.all run emit MastodonTest.HelperTest.all
port emit : ( String, Value ) -> Cmd msg port emit : ( String, Value ) -> Cmd msg

19
tests/NotificationTests.elm → tests/MastodonTest/HelperTest.elm
View File

@ -1,9 +1,8 @@
module NotificationTests exposing (..) module MastodonTest.HelperTest exposing (..)
import Test exposing (..) import Test exposing (..)
import Expect import Expect
import String import Mastodon.Helper
import Mastodon
import Fixtures import Fixtures
@ -14,7 +13,7 @@ all =
[ test "Aggregate Notifications" <| [ test "Aggregate Notifications" <|
\() -> \() ->
Fixtures.notifications Fixtures.notifications
|> Mastodon.aggregateNotifications |> Mastodon.Helper.aggregateNotifications
|> Expect.equal |> Expect.equal
[ { type_ = "mention" [ { type_ = "mention"
, status = Just Fixtures.statusNicoToVjousse , status = Just Fixtures.statusNicoToVjousse
@ -30,8 +29,8 @@ all =
, test "Add follows notification to aggregate" <| , test "Add follows notification to aggregate" <|
\() -> \() ->
Fixtures.notifications Fixtures.notifications
|> Mastodon.aggregateNotifications |> Mastodon.Helper.aggregateNotifications
|> (Mastodon.addNotificationToAggregates Fixtures.notificationPloumFollowsVjousse) |> (Mastodon.Helper.addNotificationToAggregates Fixtures.notificationPloumFollowsVjousse)
|> Expect.equal |> Expect.equal
[ { type_ = "mention" [ { type_ = "mention"
, status = Just Fixtures.statusNicoToVjousse , status = Just Fixtures.statusNicoToVjousse
@ -47,8 +46,8 @@ all =
, test "Add mention notification to aggregate" <| , test "Add mention notification to aggregate" <|
\() -> \() ->
Fixtures.notifications Fixtures.notifications
|> Mastodon.aggregateNotifications |> Mastodon.Helper.aggregateNotifications
|> (Mastodon.addNotificationToAggregates Fixtures.notificationNicoMentionVjousse) |> (Mastodon.Helper.addNotificationToAggregates Fixtures.notificationNicoMentionVjousse)
|> Expect.equal |> Expect.equal
[ { type_ = "mention" [ { type_ = "mention"
, status = Just Fixtures.statusNicoToVjousse , status = Just Fixtures.statusNicoToVjousse
@ -64,8 +63,8 @@ all =
, test "Add new mention notification to aggregate" <| , test "Add new mention notification to aggregate" <|
\() -> \() ->
Fixtures.notifications Fixtures.notifications
|> Mastodon.aggregateNotifications |> Mastodon.Helper.aggregateNotifications
|> (Mastodon.addNotificationToAggregates Fixtures.notificationNicoMentionVjousseAgain) |> (Mastodon.Helper.addNotificationToAggregates Fixtures.notificationNicoMentionVjousseAgain)
|> Expect.equal |> Expect.equal
[ { type_ = "mention" [ { type_ = "mention"
, status = Just Fixtures.statusNicoToVjousseAgain , status = Just Fixtures.statusNicoToVjousseAgain

1
tests/elm-package.json
View File

@ -18,6 +18,7 @@
"NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
"elm-community/list-extra": "6.0.0 <= v < 7.0.0", "elm-community/list-extra": "6.0.0 <= v < 7.0.0",
"elm-community/string-extra": "1.3.3 <= v < 2.0.0",
"elm-lang/core": "5.1.1 <= v < 6.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0",
"elm-lang/dom": "1.1.1 <= v < 2.0.0", "elm-lang/dom": "1.1.1 <= v < 2.0.0",
"elm-lang/html": "2.0.0 <= v < 3.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0",