Add part4

part4/src/Data/Article.elm

@@ -0,0 +1,154 @@
+module Data.Article
+    exposing
+        ( Article
+        , Body
+        , Slug
+        , Tag
+        , bodyToHtml
+        , bodyToMarkdownString
+        , decoder
+        , decoderWithBody
+        , slugParser
+        , slugToString
+        , tagDecoder
+        , tagToString
+        )
+
+import Data.Article.Author as Author exposing (Author)
+import Date exposing (Date)
+import Html exposing (Attribute, Html)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Extra
+import Json.Decode.Pipeline exposing (custom, decode, hardcoded, required)
+import Markdown
+import UrlParser
+
+
+{-| An article, optionally with an article body.
+
+To see the difference between { body : body } and { body : Maybe Body },
+consider the difference between the "view individual article" page (which
+renders one article, including its body) and the "article feed" -
+which displays multiple articles, but without bodies.
+
+This definition for `Article` means we can write:
+
+viewArticle : Article Body -> Html msg
+viewFeed : List (Article ()) -> Html msg
+
+This indicates that `viewArticle` requires an article _with a `body` present_,
+wereas `viewFeed` accepts articles with no bodies. (We could also have written
+it as `List (Article a)` to specify that feeds can accept either articles that
+have `body` present or not. Either work, given that feeds do not attempt to
+read the `body` field from articles.)
+
+This is an important distinction, because in Request.Article, the `feed`
+function produces `List (Article ())` because the API does not return bodies.
+Those articles are useful to the feed, but not to the individual article view.
+
+-}
+type alias Article a =
+    { description : String
+    , slug : Slug
+    , title : String
+    , tags : List String
+    , createdAt : Date
+    , updatedAt : Date
+    , favorited : Bool
+    , favoritesCount : Int
+    , author : Author
+    , body : a
+    }
+
+
+
+-- SERIALIZATION --
+
+
+decoder : Decoder (Article ())
+decoder =
+    baseArticleDecoder
+        |> hardcoded ()
+
+
+decoderWithBody : Decoder (Article Body)
+decoderWithBody =
+    baseArticleDecoder
+        |> required "body" bodyDecoder
+
+
+baseArticleDecoder : Decoder (a -> Article a)
+baseArticleDecoder =
+    decode Article
+        |> required "description" (Decode.map (Maybe.withDefault "") (Decode.nullable Decode.string))
+        |> required "slug" (Decode.map Slug Decode.string)
+        |> required "title" Decode.string
+        |> required "tagList" (Decode.list Decode.string)
+        |> required "createdAt" Json.Decode.Extra.date
+        |> required "updatedAt" Json.Decode.Extra.date
+        |> required "favorited" Decode.bool
+        |> required "favoritesCount" Decode.int
+        |> required "author" Author.decoder
+
+
+
+-- IDENTIFIERS --
+
+
+type Slug
+    = Slug String
+
+
+slugParser : UrlParser.Parser (Slug -> a) a
+slugParser =
+    UrlParser.custom "SLUG" (Ok << Slug)
+
+
+slugToString : Slug -> String
+slugToString (Slug slug) =
+    slug
+
+
+
+-- TAGS --
+
+
+type Tag
+    = Tag String
+
+
+tagToString : Tag -> String
+tagToString (Tag slug) =
+    slug
+
+
+tagDecoder : Decoder Tag
+tagDecoder =
+    Decode.map Tag Decode.string
+
+
+
+-- BODY --
+
+
+type Body
+    = Body Markdown
+
+
+type alias Markdown =
+    String
+
+
+bodyToHtml : Body -> List (Attribute msg) -> Html msg
+bodyToHtml (Body markdown) attributes =
+    Markdown.toHtml attributes markdown
+
+
+bodyToMarkdownString : Body -> String
+bodyToMarkdownString (Body markdown) =
+    markdown
+
+
+bodyDecoder : Decoder Body
+bodyDecoder =
+    Decode.map Body Decode.string

part4/src/Data/Article/Author.elm

@@ -0,0 +1,23 @@
+module Data.Article.Author exposing (Author, decoder)
+
+import Data.User as User exposing (Username)
+import Data.UserPhoto as UserPhoto exposing (UserPhoto)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (custom, decode, required)
+
+
+decoder : Decoder Author
+decoder =
+    decode Author
+        |> required "username" User.usernameDecoder
+        |> required "bio" (Decode.nullable Decode.string)
+        |> required "image" UserPhoto.decoder
+        |> required "following" Decode.bool
+
+
+type alias Author =
+    { username : Username
+    , bio : Maybe String
+    , image : UserPhoto
+    , following : Bool
+    }

part4/src/Data/Article/Comment.elm

@@ -0,0 +1,48 @@
+module Data.Article.Comment exposing (Comment, CommentId, commentIdDecoder, decoder, idToString)
+
+import Data.Article.Author as Author exposing (Author)
+import Date exposing (Date)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Extra
+import Json.Decode.Pipeline exposing (custom, decode, required)
+
+
+type alias Comment =
+    { id : CommentId
+    , body : String
+    , createdAt : Date
+    , updatedAt : Date
+    , author : Author
+    }
+
+
+
+-- SERIALIZATION --
+
+
+decoder : Decoder Comment
+decoder =
+    decode Comment
+        |> required "id" commentIdDecoder
+        |> required "body" Decode.string
+        |> required "createdAt" Json.Decode.Extra.date
+        |> required "updatedAt" Json.Decode.Extra.date
+        |> required "author" Author.decoder
+
+
+
+-- IDENTIFIERS --
+
+
+type CommentId
+    = CommentId Int
+
+
+idToString : CommentId -> String
+idToString (CommentId id) =
+    toString id
+
+
+commentIdDecoder : Decoder CommentId
+commentIdDecoder =
+    Decode.map CommentId Decode.int

part4/src/Data/Article/Feed.elm

@@ -0,0 +1,22 @@
+module Data.Article.Feed exposing (Feed, decoder)
+
+import Data.Article as Article exposing (Article)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (decode, required)
+
+
+type alias Feed =
+    { articles : List (Article ())
+    , articlesCount : Int
+    }
+
+
+
+-- SERIALIZATION --
+
+
+decoder : Decoder Feed
+decoder =
+    decode Feed
+        |> required "articles" (Decode.list Article.decoder)
+        |> required "articlesCount" Decode.int

part4/src/Data/AuthToken.elm

@@ -0,0 +1,31 @@
+module Data.AuthToken exposing (AuthToken, decoder, encode, withAuthorization)
+
+import HttpBuilder exposing (RequestBuilder, withHeader)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Encode as Encode exposing (Value)
+
+
+type AuthToken
+    = AuthToken String
+
+
+encode : AuthToken -> Value
+encode (AuthToken token) =
+    Encode.string token
+
+
+decoder : Decoder AuthToken
+decoder =
+    Decode.string
+        |> Decode.map AuthToken
+
+
+withAuthorization : Maybe AuthToken -> RequestBuilder a -> RequestBuilder a
+withAuthorization maybeToken builder =
+    case maybeToken of
+        Just (AuthToken token) ->
+            builder
+                |> withHeader "authorization" ("Token " ++ token)
+
+        Nothing ->
+            builder

part4/src/Data/Profile.elm

@@ -0,0 +1,23 @@
+module Data.Profile exposing (Profile, decoder)
+
+import Data.User as User exposing (Username)
+import Data.UserPhoto as UserPhoto exposing (UserPhoto)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (decode, required)
+
+
+type alias Profile =
+    { username : Username
+    , bio : Maybe String
+    , image : UserPhoto
+    , following : Bool
+    }
+
+
+decoder : Decoder Profile
+decoder =
+    decode Profile
+        |> required "username" User.usernameDecoder
+        |> required "bio" (Decode.nullable Decode.string)
+        |> required "image" UserPhoto.decoder
+        |> required "following" Decode.bool

part4/src/Data/Session.elm

@@ -0,0 +1,18 @@
+module Data.Session exposing (Session, attempt)
+
+import Data.AuthToken exposing (AuthToken)
+import Data.User exposing (User)
+
+
+type alias Session =
+    { user : Maybe User }
+
+
+attempt : String -> (AuthToken -> Cmd msg) -> Session -> ( List String, Cmd msg )
+attempt attemptedAction toCmd session =
+    case Maybe.map .token session.user of
+        Nothing ->
+            ( [ "You have been signed out. Please sign back in to " ++ attemptedAction ++ "." ], Cmd.none )
+
+        Just token ->
+            ( [], toCmd token )

part4/src/Data/User.elm

@@ -0,0 +1,83 @@
+module Data.User exposing (User, Username, decoder, encode, usernameDecoder, usernameParser, usernameToHtml, usernameToString)
+
+import Data.AuthToken as AuthToken exposing (AuthToken)
+import Data.UserPhoto as UserPhoto exposing (UserPhoto)
+import Html exposing (Html)
+import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Pipeline exposing (decode, required)
+import Json.Encode as Encode exposing (Value)
+import Json.Encode.Extra as EncodeExtra
+import UrlParser
+
+
+type alias User =
+    { email : String
+    , token : AuthToken
+    , username : Username
+    , bio : Maybe String
+    , image : UserPhoto
+    , createdAt : String
+    , updatedAt : String
+    }
+
+
+
+-- SERIALIZATION --
+
+
+decoder : Decoder User
+decoder =
+    decode User
+        |> required "email" Decode.string
+        |> required "token" AuthToken.decoder
+        |> required "username" usernameDecoder
+        |> required "bio" (Decode.nullable Decode.string)
+        |> required "image" UserPhoto.decoder
+        |> required "createdAt" Decode.string
+        |> required "updatedAt" Decode.string
+
+
+encode : User -> Value
+encode user =
+    Encode.object
+        [ ( "email", Encode.string user.email )
+        , ( "token", AuthToken.encode user.token )
+        , ( "username", encodeUsername user.username )
+        , ( "bio", EncodeExtra.maybe Encode.string user.bio )
+        , ( "image", UserPhoto.encode user.image )
+        , ( "createdAt", Encode.string user.createdAt )
+        , ( "updatedAt", Encode.string user.updatedAt )
+        ]
+
+
+
+-- IDENTIFIERS --
+
+
+type Username
+    = Username String
+
+
+usernameToString : Username -> String
+usernameToString (Username username) =
+    username
+
+
+usernameParser : UrlParser.Parser (Username -> a) a
+usernameParser =
+    UrlParser.custom "USERNAME" (Ok << Username)
+
+
+usernameDecoder : Decoder Username
+usernameDecoder =
+    Decode.map Username Decode.string
+
+
+encodeUsername : Username -> Value
+encodeUsername (Username username) =
+    Encode.string username
+
+
+usernameToHtml : Username -> Html msg
+usernameToHtml (Username username) =
+    Html.text username

part4/src/Data/UserPhoto.elm

@@ -0,0 +1,45 @@
+module Data.UserPhoto exposing (UserPhoto, decoder, encode, src, toMaybeString)
+
+import Html exposing (Attribute)
+import Html.Attributes
+import Json.Decode as Decode exposing (Decoder)
+import Json.Encode as Encode exposing (Value)
+import Json.Encode.Extra as EncodeExtra
+
+
+type UserPhoto
+    = UserPhoto (Maybe String)
+
+
+src : UserPhoto -> Attribute msg
+src =
+    photoToUrl >> Html.Attributes.src
+
+
+decoder : Decoder UserPhoto
+decoder =
+    Decode.map UserPhoto (Decode.nullable Decode.string)
+
+
+encode : UserPhoto -> Value
+encode (UserPhoto maybeUrl) =
+    EncodeExtra.maybe Encode.string maybeUrl
+
+
+toMaybeString : UserPhoto -> Maybe String
+toMaybeString (UserPhoto maybeUrl) =
+    maybeUrl
+
+
+
+-- INTERNAL --
+
+
+photoToUrl : UserPhoto -> String
+photoToUrl (UserPhoto maybeUrl) =
+    case maybeUrl of
+        Nothing ->
+            "https://static.productionready.io/images/smiley-cyrus.jpg"
+
+        Just url ->
+            url