diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Config.elm | 6 | ||||
| -rw-r--r-- | src/Header.elm | 34 | ||||
| -rw-r--r-- | src/Main.elm | 80 | ||||
| -rw-r--r-- | src/Pages/Feed.elm | 40 | ||||
| -rw-r--r-- | src/RemoteData.elm | 52 | ||||
| -rw-r--r-- | src/Types.elm | 16 | ||||
| -rw-r--r-- | src/Utils.elm | 42 |
7 files changed, 204 insertions, 66 deletions
diff --git a/src/Config.elm b/src/Config.elm index ecd263b..397bc38 100644 --- a/src/Config.elm +++ b/src/Config.elm @@ -1,5 +1,7 @@ module Config exposing (ApiResource(..), makeApiUrl) +import Utils exposing (templ) + baseUrl : String baseUrl = @@ -20,8 +22,8 @@ makeApiUrl res = "{baseUrl}/posts?_sort=createdAt&_order=desc" ApiLikePost postId -> - "{baseUrl}/posts/{postId}" - |> String.replace "{postId}" postId + "{baseUrl}/posts/{0}" + |> templ [ postId ] ApiCompose -> "{baseUrl}/posts" diff --git a/src/Header.elm b/src/Header.elm new file mode 100644 index 0000000..257b308 --- /dev/null +++ b/src/Header.elm @@ -0,0 +1,34 @@ +module Header exposing (..) + +import Css exposing (..) +import Html.Styled exposing (Html, button, div, text) +import Html.Styled.Attributes exposing (css) +import Html.Styled.Events exposing (onClick) +import Types exposing (Model, Msg(..)) +import Utils exposing (templ) + + +styles = + { container = + css + [ displayFlex + , flexFlow2 row wrap + , justifyContent flexEnd + , width (pct 100) + , marginBottom (px 10) + ] + , logoutButton = + css + [ marginLeft (px 10) + , cursor pointer + ] + } + + +headerView : Model -> List (Html Msg) +headerView model = + [ div [ styles.container ] + [ div [] [ "Logged in as {0}" |> templ [ model.userData.name ] |> text ] + , button [ styles.logoutButton, onClick RequestLogout ] [ text "Logout" ] + ] + ] diff --git a/src/Main.elm b/src/Main.elm index 9d55d9c..9f5b699 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -3,19 +3,21 @@ port module Main exposing (..) import Browser exposing (Document) import Browser.Navigation exposing (Key) import Config exposing (makeApiUrl) +import Header exposing (headerView) import Html.Styled exposing (..) -import Html.Styled.Events exposing (onClick) import Http -import Json.Decode exposing (Decoder, field, int, list, map2, map5, string) +import Json.Decode exposing (Decoder, field, int, list, map2, map6, string) import Json.Encode import Pages.Feed exposing (feedView) +import RemoteData import Task import Time -import Types exposing (Author, Model, Msg(..), Post) +import Types exposing (Author, Model, Msg(..), Post, UserData) import Url exposing (Url) +import Utils exposing (httpErrorToString, listFlat) -main : Program () Model Msg +main : Program UserData Model Msg main = Browser.application { init = init @@ -41,13 +43,18 @@ port requestLogout : () -> Cmd msg -- INIT -init : () -> Url -> Key -> ( Model, Cmd Msg ) -init _ _ _ = - ( { posts = Nothing - , now = Time.millisToPosix 0 +init : UserData -> Url -> Key -> ( Model, Cmd Msg ) +init userData _ key = + ( { now = Time.millisToPosix 0 + , key = key + , userData = userData + , posts = RemoteData.Loading , composeInputValue = "" } - , Cmd.batch [ getPosts, Task.perform SetNowPosix Time.now ] + , Cmd.batch + [ getPosts + , Task.perform SetNowPosix Time.now + ] ) @@ -71,10 +78,10 @@ update msg model = ( model, getPosts ) GotPosts (Result.Ok posts) -> - ( { model | posts = Just posts }, Cmd.none ) + ( { model | posts = RemoteData.Success posts }, Cmd.none ) GotPosts (Result.Err httpErr) -> - ( model + ( { model | posts = RemoteData.Failure httpErr } , showAlert <| httpErrorToString httpErr ) @@ -82,7 +89,7 @@ update msg model = ( model, likePost post ) LikedPost (Result.Ok post) -> - ( { model | posts = Just <| replaceMatchingPost post (Maybe.withDefault [] model.posts) } + ( { model | posts = RemoteData.map (replaceMatchingPost post) model.posts } , Cmd.none ) @@ -105,7 +112,7 @@ update msg model = ComposedPost (Result.Ok post) -> ( { model - | posts = Maybe.map (\posts -> post :: posts) model.posts + | posts = RemoteData.map (\posts -> post :: posts) model.posts , composeInputValue = "" } , Cmd.none @@ -166,10 +173,11 @@ composePost model = [ ( "content", Json.Encode.string model.composeInputValue ) , ( "createdAt", Json.Encode.int <| Time.posixToMillis model.now // 1000 ) , ( "likes", Json.Encode.int 0 ) + , ( "userPictureUrl", Json.Encode.string model.userData.pictureUrl ) , ( "author" , Json.Encode.object - [ ( "id", Json.Encode.string "logged-in-user-id" ) - , ( "name", Json.Encode.string "Logged in user" ) + [ ( "id", Json.Encode.string model.userData.email ) + , ( "name", Json.Encode.string model.userData.name ) ] ) ] @@ -202,7 +210,7 @@ postsDecoder = postDecoder : Decoder Post postDecoder = - map5 Post + map6 Post (field "id" string) (field "content" string) (field "author" @@ -213,6 +221,7 @@ postDecoder = ) (field "createdAt" decodeTime) (field "likes" int) + (field "userPictureUrl" string) @@ -222,39 +231,8 @@ postDecoder = view : Model -> Document Msg view model = { title = "Shoob book" - , body = button [ onClick RequestLogout ] [ text "Logout" ] :: feedView model |> List.map toUnstyled + , body = + [ headerView model, feedView model ] + |> listFlat + |> List.map toUnstyled } - - - --- UTILS - - -httpErrorToString : Http.Error -> String -httpErrorToString err = - case err of - Http.BadUrl url -> - "URL {0} is invalid" |> templ [ url ] - - Http.Timeout -> - "Request has timed out" - - Http.NetworkError -> - "Unable to reach the server, check your network connection" - - Http.BadStatus status -> - "Server responded with status {0}" |> templ [ String.fromInt status ] - - Http.BadBody msg -> - msg - - -templ : List String -> String -> String -templ rs original = - let - templElement_ : ( Int, String ) -> String -> String - templElement_ ( index, r ) orig_ = - String.replace ("{" ++ String.fromInt index ++ "}") r orig_ - in - List.indexedMap Tuple.pair rs - |> List.foldl templElement_ original diff --git a/src/Pages/Feed.elm b/src/Pages/Feed.elm index 824552a..7fbe98a 100644 --- a/src/Pages/Feed.elm +++ b/src/Pages/Feed.elm @@ -3,18 +3,16 @@ module Pages.Feed exposing (..) import Css exposing (..) import DateFormat.Relative exposing (relativeTime) import Html.Styled exposing (..) -import Html.Styled.Attributes exposing (css, placeholder, type_, value) +import Html.Styled.Attributes exposing (css, placeholder, src, type_, value) import Html.Styled.Events exposing (onClick, onInput, onSubmit) +import RemoteData exposing (RemoteData(..)) import Time exposing (now) import Types exposing (Model, Msg(..), Post) styles = { page = - css - [ maxWidth (px 600) - , margin2 (px 10) auto - ] + css [ margin2 (px 10) auto ] , postList = css [ overflow scroll @@ -27,6 +25,16 @@ styles = , backgroundColor (hex "#eee") , marginBottom (px 10) ] + , postProfilePicture = + css + [ width (px 40) + , height (px 40) + ] + , postHeader = + css + [ display inlineBlock + , marginLeft (px 10) + ] , postTitle = css [ margin (px 0) ] @@ -50,9 +58,13 @@ styles = postDiv : Time.Posix -> Post -> Html Msg postDiv now post = div [ styles.post ] - [ h3 [ styles.postTitle ] [ text post.author.name ] - , i [] - [ text <| relativeTime now post.createdAt + [ span [] + [ img [ styles.postProfilePicture, src post.userPictureUrl ] [] ] + , span [ styles.postHeader ] + [ h3 [ styles.postTitle ] [ text post.author.name ] + , i [] + [ text <| relativeTime now post.createdAt + ] ] , p [] [ text post.content ] , span [] @@ -65,12 +77,18 @@ postDiv now post = postsDiv : Model -> Html Msg postsDiv model = case model.posts of - Just posts -> - div [ styles.postList ] <| List.map (postDiv model.now) posts + Initial -> + div [] [] - Nothing -> + Loading -> div [] [ text "Loading posts..." ] + Failure _ -> + div [] [] + + Success posts -> + div [ styles.postList ] <| List.map (postDiv model.now) posts + composeDiv : Model -> Html Msg composeDiv model = diff --git a/src/RemoteData.elm b/src/RemoteData.elm new file mode 100644 index 0000000..7173851 --- /dev/null +++ b/src/RemoteData.elm @@ -0,0 +1,52 @@ +module RemoteData exposing (..) + +import Http + + +type RemoteData a + = Initial + | Loading + | Failure Http.Error + | Success a + + +withDefault : a -> RemoteData a -> a +withDefault default rd = + case rd of + Success value -> + value + + _ -> + default + + +map : (a -> b) -> RemoteData a -> RemoteData b +map fn rd = + case rd of + Initial -> + Initial + + Loading -> + Loading + + Failure err -> + Failure err + + Success value -> + Success (fn value) + + +andThen : (a -> RemoteData b) -> RemoteData a -> RemoteData b +andThen callback rd = + case rd of + Initial -> + Initial + + Loading -> + Loading + + Failure err -> + Failure err + + Success value -> + callback value diff --git a/src/Types.elm b/src/Types.elm index ce487b6..d5068d6 100644 --- a/src/Types.elm +++ b/src/Types.elm @@ -1,13 +1,24 @@ module Types exposing (..) +import Browser.Navigation exposing (Key) import Http +import RemoteData exposing (RemoteData) import Time type alias Model = - { posts : Maybe (List Post) + { now : Time.Posix + , key : Key + , userData : UserData + , posts : RemoteData (List Post) , composeInputValue : String - , now : Time.Posix + } + + +type alias UserData = + { name : String + , email : String + , pictureUrl : String } @@ -39,4 +50,5 @@ type alias Post = , author : Author , createdAt : Time.Posix , likes : Int + , userPictureUrl : String } diff --git a/src/Utils.elm b/src/Utils.elm new file mode 100644 index 0000000..3da2c74 --- /dev/null +++ b/src/Utils.elm @@ -0,0 +1,42 @@ +module Utils exposing (..) + +import Http + + + +-- UTILS + + +httpErrorToString : Http.Error -> String +httpErrorToString err = + case err of + Http.BadUrl url -> + "URL {0} is invalid" |> templ [ url ] + + Http.Timeout -> + "Request has timed out" + + Http.NetworkError -> + "Unable to reach the server, check your network connection" + + Http.BadStatus status -> + "Server responded with status {0}" |> templ [ String.fromInt status ] + + Http.BadBody msg -> + msg + + +templ : List String -> String -> String +templ rs original = + let + templElement_ : ( Int, String ) -> String -> String + templElement_ ( index, r ) orig_ = + String.replace (String.replace "n" (String.fromInt index) "{n}") r orig_ + in + List.indexedMap Tuple.pair rs + |> List.foldl templElement_ original + + +listFlat : List (List a) -> List a +listFlat ll = + List.foldl (\acc l -> l ++ acc) [] ll |