Add part5
6
intro/part5/.gitignore
vendored
Normal file
@@ -0,0 +1,6 @@
|
|||||||
|
# elm-package generated files
|
||||||
|
elm-stuff/
|
||||||
|
# elm-repl generated files
|
||||||
|
repl-temp-*
|
||||||
|
|
||||||
|
elm.js
|
||||||
34
intro/part5/.travis.yml
Normal file
@@ -0,0 +1,34 @@
|
|||||||
|
sudo: false
|
||||||
|
|
||||||
|
cache:
|
||||||
|
directories:
|
||||||
|
- tests/elm-stuff/build-artifacts
|
||||||
|
- sysconfcpus
|
||||||
|
|
||||||
|
before_install:
|
||||||
|
- echo -e "Host github.com\n\tStrictHostKeyChecking no\n" >> ~/.ssh/config
|
||||||
|
- | # epic build time improvement - see https://github.com/elm-lang/elm-compiler/issues/1473#issuecomment-245704142
|
||||||
|
if [ ! -d sysconfcpus/bin ];
|
||||||
|
then
|
||||||
|
git clone https://github.com/obmarg/libsysconfcpus.git;
|
||||||
|
cd libsysconfcpus;
|
||||||
|
./configure --prefix=$TRAVIS_BUILD_DIR/sysconfcpus;
|
||||||
|
make && make install;
|
||||||
|
cd ..;
|
||||||
|
fi
|
||||||
|
|
||||||
|
|
||||||
|
install:
|
||||||
|
- npm install -g elm@0.18.0 elm-test elm-format@exp
|
||||||
|
- mv $(npm config get prefix)/bin/elm-make $(npm config get prefix)/bin/elm-make-old
|
||||||
|
- printf '%s\n\n' '#!/bin/bash' 'echo "Running elm-make with sysconfcpus -n 2"' '$TRAVIS_BUILD_DIR/sysconfcpus/bin/sysconfcpus -n 2 elm-make-old "$@"' > $(npm config get prefix)/bin/elm-make
|
||||||
|
- chmod +x $(npm config get prefix)/bin/elm-make
|
||||||
|
- travis_retry elm-package install --yes
|
||||||
|
- cd tests
|
||||||
|
- npm install
|
||||||
|
- travis_retry elm-package install --yes
|
||||||
|
- cd ..
|
||||||
|
|
||||||
|
script:
|
||||||
|
- elm-format --validate src tests
|
||||||
|
- elm test
|
||||||
32
intro/part5/README.md
Normal file
@@ -0,0 +1,32 @@
|
|||||||
|
# Part 5
|
||||||
|
|
||||||
|
This time, we'll still be *building* `src/Main.elm`, but a few things will be different:
|
||||||
|
|
||||||
|
1. We'll be *editing* a different file. (`elm make` will figure out it needs to compile our edited file as well, because `src/Main.elm` imports it!)
|
||||||
|
2. We'll open `localhost:3000` instead of `index.html`.
|
||||||
|
3. We'll specify a different `--output` target. (Explained next.)
|
||||||
|
|
||||||
|
To build everything, `cd` into the `part5/` directory and run:
|
||||||
|
|
||||||
|
```shell
|
||||||
|
elm make src/Main.elm --output ../server/public/elm.js
|
||||||
|
```
|
||||||
|
|
||||||
|
Then open `http://localhost:3000/#/register` in your browser. (Opening `index.html` will not work anymore; from now on we'll be using the server we set up at the beginning of the workshop!)
|
||||||
|
|
||||||
|
## Exercise
|
||||||
|
|
||||||
|
Open `src/Page/Register.elm` in your editor and resolve the TODO there.
|
||||||
|
|
||||||
|
This time we'll be fixing a bug in an existing code base! It's only one TODO,
|
||||||
|
so that you have time to orient yourself in an unfamiliar code base.
|
||||||
|
|
||||||
|
Because this is a more real-world code base, it uses some concepts we haven't
|
||||||
|
covered yet. For example, you may be wondering things like "What does Cmd.none
|
||||||
|
do?" This is okay! You won't need to know those concepts to complete the exercise.
|
||||||
|
|
||||||
|
You may surprise yourself at how well you can already navigate around an Elm
|
||||||
|
code base, despite not knowing 100% of what the code is doing. As you'll
|
||||||
|
see, the compiler has your back!
|
||||||
|
|
||||||
|
|
||||||
BIN
intro/part5/assets/icons/android-chrome-192x192.png
Normal file
|
After Width: | Height: | Size: 2.7 KiB |
BIN
intro/part5/assets/icons/android-chrome-512x512.png
Normal file
|
After Width: | Height: | Size: 9.4 KiB |
BIN
intro/part5/assets/icons/apple-touch-icon.png
Normal file
|
After Width: | Height: | Size: 2.3 KiB |
9
intro/part5/assets/icons/browserconfig.xml
Normal file
@@ -0,0 +1,9 @@
|
|||||||
|
<?xml version="1.0" encoding="utf-8"?>
|
||||||
|
<browserconfig>
|
||||||
|
<msapplication>
|
||||||
|
<tile>
|
||||||
|
<square150x150logo src="/mstile-150x150.png"/>
|
||||||
|
<TileColor>#da532c</TileColor>
|
||||||
|
</tile>
|
||||||
|
</msapplication>
|
||||||
|
</browserconfig>
|
||||||
BIN
intro/part5/assets/icons/favicon-16x16.png
Normal file
|
After Width: | Height: | Size: 736 B |
BIN
intro/part5/assets/icons/favicon-32x32.png
Normal file
|
After Width: | Height: | Size: 985 B |
BIN
intro/part5/assets/icons/favicon.ico
Normal file
|
After Width: | Height: | Size: 15 KiB |
BIN
intro/part5/assets/icons/mstile-144x144.png
Normal file
|
After Width: | Height: | Size: 1.9 KiB |
BIN
intro/part5/assets/icons/mstile-150x150.png
Normal file
|
After Width: | Height: | Size: 2.2 KiB |
BIN
intro/part5/assets/icons/mstile-310x150.png
Normal file
|
After Width: | Height: | Size: 2.5 KiB |
BIN
intro/part5/assets/icons/mstile-310x310.png
Normal file
|
After Width: | Height: | Size: 4.1 KiB |
BIN
intro/part5/assets/icons/mstile-70x70.png
Normal file
|
After Width: | Height: | Size: 1.5 KiB |
29
intro/part5/assets/icons/safari-pinned-tab.svg
Normal file
@@ -0,0 +1,29 @@
|
|||||||
|
<?xml version="1.0" standalone="no"?>
|
||||||
|
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20010904//EN"
|
||||||
|
"http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">
|
||||||
|
<svg version="1.0" xmlns="http://www.w3.org/2000/svg"
|
||||||
|
width="700.000000pt" height="700.000000pt" viewBox="0 0 700.000000 700.000000"
|
||||||
|
preserveAspectRatio="xMidYMid meet">
|
||||||
|
<metadata>
|
||||||
|
Created by potrace 1.11, written by Peter Selinger 2001-2013
|
||||||
|
</metadata>
|
||||||
|
<g transform="translate(0.000000,700.000000) scale(0.100000,-0.100000)"
|
||||||
|
fill="#000000" stroke="none">
|
||||||
|
<path d="M235 6959 c22 -22 365 -365 761 -762 l721 -722 1652 0 c908 -1 1651
|
||||||
|
2 1651 5 0 3 -341 346 -758 763 l-757 757 -1655 0 -1654 0 39 -41z"/>
|
||||||
|
<path d="M3900 6995 c0 -3 698 -704 1550 -1557 l1550 -1551 0 1557 0 1556
|
||||||
|
-1550 0 c-852 0 -1550 -2 -1550 -5z"/>
|
||||||
|
<path d="M0 3495 l0 -3310 1655 1655 c909 910 1653 1655 1652 1657 -5 5 -3235
|
||||||
|
3237 -3269 3270 l-38 37 0 -3309z"/>
|
||||||
|
<path d="M2008 5199 c-5 -3 329 -345 743 -758 l752 -752 753 753 c414 414 751
|
||||||
|
755 748 757 -6 7 -2985 7 -2996 0z"/>
|
||||||
|
<path d="M4522 4327 c-452 -453 -822 -827 -822 -831 0 -4 369 -376 821 -828
|
||||||
|
l821 -821 829 829 829 829 -822 822 c-453 453 -825 823 -828 823 -3 0 -375
|
||||||
|
-370 -828 -823z"/>
|
||||||
|
<path d="M1853 1655 c-904 -905 -1643 -1647 -1643 -1650 0 -3 1484 -5 3297 -5
|
||||||
|
l3298 0 -1650 1650 c-907 908 -1652 1650 -1655 1650 -3 0 -744 -741 -1647
|
||||||
|
-1645z"/>
|
||||||
|
<path d="M6265 2384 c-396 -398 -722 -726 -724 -728 -2 -3 326 -335 728 -737
|
||||||
|
l731 -732 0 1461 c0 804 -3 1462 -7 1461 -5 -1 -332 -327 -728 -725z"/>
|
||||||
|
</g>
|
||||||
|
</svg>
|
||||||
|
After Width: | Height: | Size: 1.4 KiB |
BIN
intro/part5/assets/images/error.jpg
Normal file
|
After Width: | Height: | Size: 72 KiB |
17
intro/part5/assets/images/loading.svg
Normal file
@@ -0,0 +1,17 @@
|
|||||||
|
<svg class="lds-blocks" width="200px" height="200px" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0 0 100 100" preserveAspectRatio="xMidYMid" style="animation-play-state: running; animation-delay: 0s; background: none;"><rect x="19" y="19" width="20" height="20" fill="#346b21" style="animation-play-state: running; animation-delay: 0s;">
|
||||||
|
<animate attributeName="fill" values="#94d137;#346b21;#346b21" keyTimes="0;0.125;1" dur="1s" repeatCount="indefinite" begin="0s" calcMode="discrete" style="animation-play-state: running; animation-delay: 0s;"></animate>
|
||||||
|
</rect><rect x="40" y="19" width="20" height="20" fill="#346b21" style="animation-play-state: running; animation-delay: 0s;">
|
||||||
|
<animate attributeName="fill" values="#94d137;#346b21;#346b21" keyTimes="0;0.125;1" dur="1s" repeatCount="indefinite" begin="0.125s" calcMode="discrete" style="animation-play-state: running; animation-delay: 0s;"></animate>
|
||||||
|
</rect><rect x="61" y="19" width="20" height="20" fill="#346b21" style="animation-play-state: running; animation-delay: 0s;">
|
||||||
|
<animate attributeName="fill" values="#94d137;#346b21;#346b21" keyTimes="0;0.125;1" dur="1s" repeatCount="indefinite" begin="0.25s" calcMode="discrete" style="animation-play-state: running; animation-delay: 0s;"></animate>
|
||||||
|
</rect><rect x="19" y="40" width="20" height="20" fill="#346b21" style="animation-play-state: running; animation-delay: 0s;">
|
||||||
|
<animate attributeName="fill" values="#94d137;#346b21;#346b21" keyTimes="0;0.125;1" dur="1s" repeatCount="indefinite" begin="0.875s" calcMode="discrete" style="animation-play-state: running; animation-delay: 0s;"></animate>
|
||||||
|
</rect><rect x="61" y="40" width="20" height="20" fill="#346b21" style="animation-play-state: running; animation-delay: 0s;">
|
||||||
|
<animate attributeName="fill" values="#94d137;#346b21;#346b21" keyTimes="0;0.125;1" dur="1s" repeatCount="indefinite" begin="0.375s" calcMode="discrete" style="animation-play-state: running; animation-delay: 0s;"></animate>
|
||||||
|
</rect><rect x="19" y="61" width="20" height="20" fill="#346b21" style="animation-play-state: running; animation-delay: 0s;">
|
||||||
|
<animate attributeName="fill" values="#94d137;#346b21;#346b21" keyTimes="0;0.125;1" dur="1s" repeatCount="indefinite" begin="0.75s" calcMode="discrete" style="animation-play-state: running; animation-delay: 0s;"></animate>
|
||||||
|
</rect><rect x="40" y="61" width="20" height="20" fill="#346b21" style="animation-play-state: running; animation-delay: 0s;">
|
||||||
|
<animate attributeName="fill" values="#94d137;#346b21;#346b21" keyTimes="0;0.125;1" dur="1s" repeatCount="indefinite" begin="0.625s" calcMode="discrete" style="animation-play-state: running; animation-delay: 0s;"></animate>
|
||||||
|
</rect><rect x="61" y="61" width="20" height="20" fill="#346b21" style="animation-play-state: running; animation-delay: 0s;">
|
||||||
|
<animate attributeName="fill" values="#94d137;#346b21;#346b21" keyTimes="0;0.125;1" dur="1s" repeatCount="indefinite" begin="0.5s" calcMode="discrete" style="animation-play-state: running; animation-delay: 0s;"></animate>
|
||||||
|
</rect></svg>
|
||||||
|
After Width: | Height: | Size: 3.0 KiB |
19
intro/part5/assets/site.webmanifest
Normal file
@@ -0,0 +1,19 @@
|
|||||||
|
{
|
||||||
|
"name": "",
|
||||||
|
"short_name": "",
|
||||||
|
"icons": [
|
||||||
|
{
|
||||||
|
"src": "/android-chrome-192x192.png",
|
||||||
|
"sizes": "192x192",
|
||||||
|
"type": "image/png"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"src": "/android-chrome-512x512.png",
|
||||||
|
"sizes": "512x512",
|
||||||
|
"type": "image/png"
|
||||||
|
}
|
||||||
|
],
|
||||||
|
"theme_color": "#ffffff",
|
||||||
|
"background_color": "#ffffff",
|
||||||
|
"display": "standalone"
|
||||||
|
}
|
||||||
35
intro/part5/elm.json
Normal file
@@ -0,0 +1,35 @@
|
|||||||
|
{
|
||||||
|
"type": "application",
|
||||||
|
"source-directories": [
|
||||||
|
"src"
|
||||||
|
],
|
||||||
|
"elm-version": "0.19.0",
|
||||||
|
"dependencies": {
|
||||||
|
"direct": {
|
||||||
|
"NoRedInk/json-decode-pipeline": "1.0.0",
|
||||||
|
"elm/browser": "1.0.0",
|
||||||
|
"elm/core": "1.0.0",
|
||||||
|
"elm/html": "1.0.0",
|
||||||
|
"elm/http": "1.0.0",
|
||||||
|
"elm/json": "1.0.0",
|
||||||
|
"elm/time": "1.0.0",
|
||||||
|
"elm/url": "1.0.0",
|
||||||
|
"elm-explorations/markdown": "1.0.0",
|
||||||
|
"lukewestby/elm-http-builder": "6.0.0",
|
||||||
|
"rtfeldman/elm-iso8601": "1.0.1"
|
||||||
|
},
|
||||||
|
"indirect": {
|
||||||
|
"elm/parser": "1.0.0",
|
||||||
|
"elm/regex": "1.0.0",
|
||||||
|
"elm/virtual-dom": "1.0.0"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"test-dependencies": {
|
||||||
|
"direct": {
|
||||||
|
"elm-explorations/test": "1.0.0"
|
||||||
|
},
|
||||||
|
"indirect": {
|
||||||
|
"elm/random": "1.0.0"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
41
intro/part5/index.html
Normal file
@@ -0,0 +1,41 @@
|
|||||||
|
<!DOCTYPE html>
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<meta charset="utf-8">
|
||||||
|
<title>Conduit</title>
|
||||||
|
|
||||||
|
<link rel="apple-touch-icon" sizes="180x180" href="/assets/icons/apple-touch-icon.png">
|
||||||
|
<link rel="icon" type="image/png" sizes="32x32" href="/assets/icons/favicon-32x32.png">
|
||||||
|
<link rel="icon" type="image/png" sizes="16x16" href="/assets/icons/favicon-16x16.png">
|
||||||
|
<link rel="manifest" href="/assets/site.webmanifest">
|
||||||
|
<link rel="mask-icon" href="/assets/icons/safari-pinned-tab.svg" color="#5bbad5">
|
||||||
|
<meta name="msapplication-TileColor" content="#da532c">
|
||||||
|
<meta name="theme-color" content="#ffffff">
|
||||||
|
|
||||||
|
<!-- Import Ionicon icons & Google Fonts our Bootstrap theme relies on -->
|
||||||
|
<link href="//code.ionicframework.com/ionicons/2.0.1/css/ionicons.min.css" rel="stylesheet" type="text/css">
|
||||||
|
<link href="//fonts.googleapis.com/css?family=Titillium+Web:700|Source+Serif+Pro:400,700|Merriweather+Sans:400,700|Source+Sans+Pro:400,300,600,700,300italic,400italic,600italic,700italic" rel="stylesheet" type="text/css">
|
||||||
|
<!-- Import the custom Bootstrap 4 theme from our hosted CDN -->
|
||||||
|
<link rel="stylesheet" href="//demo.productionready.io/main.css">
|
||||||
|
|
||||||
|
<script src="elm.js"></script>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<script>
|
||||||
|
var app = Elm.Main.init({flags: localStorage.session || null});
|
||||||
|
|
||||||
|
app.ports.storeSession.subscribe(function(session) {
|
||||||
|
localStorage.session = session;
|
||||||
|
|
||||||
|
// Report that the new session was stored succesfully.
|
||||||
|
setTimeout(function() { app.ports.onSessionChange.send(session); }, 0);
|
||||||
|
});
|
||||||
|
|
||||||
|
window.addEventListener("storage", function(event) {
|
||||||
|
if (event.storageArea === localStorage && event.key === "session") {
|
||||||
|
app.ports.onSessionChange.send(event.newValue);
|
||||||
|
}
|
||||||
|
}, false);
|
||||||
|
</script>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
53
intro/part5/src/Api.elm
Normal file
@@ -0,0 +1,53 @@
|
|||||||
|
module Api exposing (addServerError, decodeErrors, url)
|
||||||
|
|
||||||
|
import Http
|
||||||
|
import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
|
||||||
|
import Json.Decode.Pipeline as Pipeline exposing (optional)
|
||||||
|
import Url.Builder
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- URL
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get a URL to the Conduit API.
|
||||||
|
-}
|
||||||
|
url : List String -> String
|
||||||
|
url paths =
|
||||||
|
-- NOTE: Url.Builder takes care of percent-encoding special URL characters.
|
||||||
|
-- See https://package.elm-lang.org/packages/elm/url/latest/Url#percentEncode
|
||||||
|
Url.Builder.relative ("api" :: paths) []
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- ERRORS
|
||||||
|
|
||||||
|
|
||||||
|
addServerError : List String -> List String
|
||||||
|
addServerError list =
|
||||||
|
"Server error" :: list
|
||||||
|
|
||||||
|
|
||||||
|
{-| Many API endpoints include an "errors" field in their BadStatus responses.
|
||||||
|
-}
|
||||||
|
decodeErrors : Http.Error -> List String
|
||||||
|
decodeErrors error =
|
||||||
|
case error of
|
||||||
|
Http.BadStatus response ->
|
||||||
|
response.body
|
||||||
|
|> decodeString (field "errors" errorsDecoder)
|
||||||
|
|> Result.withDefault [ "Server error" ]
|
||||||
|
|
||||||
|
err ->
|
||||||
|
[ "Server error" ]
|
||||||
|
|
||||||
|
|
||||||
|
errorsDecoder : Decoder (List String)
|
||||||
|
errorsDecoder =
|
||||||
|
Decode.keyValuePairs (Decode.list Decode.string)
|
||||||
|
|> Decode.map (List.concatMap fromPair)
|
||||||
|
|
||||||
|
|
||||||
|
fromPair : ( String, List String ) -> List String
|
||||||
|
fromPair ( field, errors ) =
|
||||||
|
List.map (\error -> field ++ " " ++ error) errors
|
||||||
321
intro/part5/src/Article.elm
Normal file
@@ -0,0 +1,321 @@
|
|||||||
|
module Article
|
||||||
|
exposing
|
||||||
|
( Article
|
||||||
|
, Full
|
||||||
|
, Preview
|
||||||
|
, author
|
||||||
|
, body
|
||||||
|
, favorite
|
||||||
|
, favoriteButton
|
||||||
|
, fetch
|
||||||
|
, fromPreview
|
||||||
|
, fullDecoder
|
||||||
|
, mapAuthor
|
||||||
|
, metadata
|
||||||
|
, previewDecoder
|
||||||
|
, slug
|
||||||
|
, unfavorite
|
||||||
|
, unfavoriteButton
|
||||||
|
, url
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| The interface to the Article data structure.
|
||||||
|
|
||||||
|
This includes:
|
||||||
|
|
||||||
|
- The Article type itself
|
||||||
|
- Ways to make HTTP requests to retrieve and modify articles
|
||||||
|
- Ways to access information about an article
|
||||||
|
- Converting between various types
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Article.Body as Body exposing (Body)
|
||||||
|
import Article.Slug as Slug exposing (Slug)
|
||||||
|
import Article.Tag as Tag exposing (Tag)
|
||||||
|
import Author exposing (Author)
|
||||||
|
import Html exposing (Attribute, Html, i)
|
||||||
|
import Html.Attributes exposing (class)
|
||||||
|
import Html.Events exposing (stopPropagationOn)
|
||||||
|
import Http
|
||||||
|
import HttpBuilder exposing (RequestBuilder, withBody, withExpect, withQueryParams)
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Decode.Pipeline exposing (custom, hardcoded, required)
|
||||||
|
import Json.Encode as Encode
|
||||||
|
import Markdown
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Time
|
||||||
|
import Timestamp
|
||||||
|
import Username as Username exposing (Username)
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
{-| An article, optionally with an article body.
|
||||||
|
|
||||||
|
To see the difference between { extraInfo : a } and { extraInfo : 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 Full -> Html msg
|
||||||
|
viewFeed : List (Article Preview) -> 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 Preview)` because the API does not return bodies.
|
||||||
|
Those articles are useful to the feed, but not to the individual article view.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type Article a
|
||||||
|
= Article Internals a
|
||||||
|
|
||||||
|
|
||||||
|
{-| Metadata about the article - its title, description, and so on.
|
||||||
|
|
||||||
|
Importantly, this module's public API exposes a way to read this metadata, but
|
||||||
|
not to alter it. This is read-only information!
|
||||||
|
|
||||||
|
If we find ourselves using any particular piece of metadata often,
|
||||||
|
for example `title`, we could expose a convenience function like this:
|
||||||
|
|
||||||
|
Article.title : Article a -> String
|
||||||
|
|
||||||
|
If you like, it's totally reasonable to expose a function like that for every one
|
||||||
|
of these fields!
|
||||||
|
|
||||||
|
(Okay, to be completely honest, exposing one function per field is how I prefer
|
||||||
|
to do it, and that's how I originally wrote this module. However, I'm aware that
|
||||||
|
this code base has become a common reference point for beginners, and I think it
|
||||||
|
is _extremely important_ that slapping some "getters and setters" on a record
|
||||||
|
does not become a habit for anyone who is getting started with Elm. The whole
|
||||||
|
point of making the Article type opaque is to create guarantees through
|
||||||
|
_selectively choosing boundaries_ around it. If you aren't selective about
|
||||||
|
where those boundaries are, and instead expose a "getter and setter" for every
|
||||||
|
field in the record, the result is an API with no more guarantees than if you'd
|
||||||
|
exposed the entire record directly! It is so important to me that beginners not
|
||||||
|
fall into the terrible "getters and setters" trap that I've exposed this
|
||||||
|
Metadata record instead of exposing a single function for each of its fields,
|
||||||
|
as I did originally. This record is not a bad way to do it, by any means,
|
||||||
|
but if this seems at odds with <https://youtu.be/x1FU3e0sT1I> - now you know why!
|
||||||
|
See commit c2640ae3abd60262cdaafe6adee3f41d84cd85c3 for how it looked before.
|
||||||
|
)
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias Metadata =
|
||||||
|
{ description : String
|
||||||
|
, title : String
|
||||||
|
, tags : List String
|
||||||
|
, createdAt : Time.Posix
|
||||||
|
, favorited : Bool
|
||||||
|
, favoritesCount : Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Internals =
|
||||||
|
{ slug : Slug
|
||||||
|
, author : Author
|
||||||
|
, metadata : Metadata
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type Preview
|
||||||
|
= Preview
|
||||||
|
|
||||||
|
|
||||||
|
type Full
|
||||||
|
= Full Body
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INFO
|
||||||
|
|
||||||
|
|
||||||
|
author : Article a -> Author
|
||||||
|
author (Article internals _) =
|
||||||
|
internals.author
|
||||||
|
|
||||||
|
|
||||||
|
metadata : Article a -> Metadata
|
||||||
|
metadata (Article internals _) =
|
||||||
|
internals.metadata
|
||||||
|
|
||||||
|
|
||||||
|
slug : Article a -> Slug
|
||||||
|
slug (Article internals _) =
|
||||||
|
internals.slug
|
||||||
|
|
||||||
|
|
||||||
|
body : Article Full -> Body
|
||||||
|
body (Article _ (Full extraInfo)) =
|
||||||
|
extraInfo
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TRANSFORM
|
||||||
|
|
||||||
|
|
||||||
|
{-| This is the only way you can transform an existing article:
|
||||||
|
you can change its author (e.g. to follow or unfollow them).
|
||||||
|
All other article data necessarily comes from the server!
|
||||||
|
|
||||||
|
We can tell this for sure by looking at the types of the exposed functions
|
||||||
|
in this module.
|
||||||
|
|
||||||
|
-}
|
||||||
|
mapAuthor : (Author -> Author) -> Article a -> Article a
|
||||||
|
mapAuthor transform (Article info extras) =
|
||||||
|
Article { info | author = transform info.author } extras
|
||||||
|
|
||||||
|
|
||||||
|
fromPreview : Body -> Article Preview -> Article Full
|
||||||
|
fromPreview newBody (Article info Preview) =
|
||||||
|
Article info (Full newBody)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SERIALIZATION
|
||||||
|
|
||||||
|
|
||||||
|
previewDecoder : Maybe Cred -> Decoder (Article Preview)
|
||||||
|
previewDecoder maybeCred =
|
||||||
|
Decode.succeed Article
|
||||||
|
|> custom (internalsDecoder maybeCred)
|
||||||
|
|> hardcoded Preview
|
||||||
|
|
||||||
|
|
||||||
|
fullDecoder : Maybe Cred -> Decoder (Article Full)
|
||||||
|
fullDecoder maybeCred =
|
||||||
|
Decode.succeed Article
|
||||||
|
|> custom (internalsDecoder maybeCred)
|
||||||
|
|> required "body" (Decode.map Full Body.decoder)
|
||||||
|
|
||||||
|
|
||||||
|
internalsDecoder : Maybe Cred -> Decoder Internals
|
||||||
|
internalsDecoder maybeCred =
|
||||||
|
Decode.succeed Internals
|
||||||
|
|> required "slug" Slug.decoder
|
||||||
|
|> required "author" (Author.decoder maybeCred)
|
||||||
|
|> custom metadataDecoder
|
||||||
|
|
||||||
|
|
||||||
|
metadataDecoder : Decoder Metadata
|
||||||
|
metadataDecoder =
|
||||||
|
Decode.succeed Metadata
|
||||||
|
|> required "description" (Decode.map (Maybe.withDefault "") (Decode.nullable Decode.string))
|
||||||
|
|> required "title" Decode.string
|
||||||
|
|> required "tagList" (Decode.list Decode.string)
|
||||||
|
|> required "createdAt" Timestamp.iso8601Decoder
|
||||||
|
|> required "favorited" Decode.bool
|
||||||
|
|> required "favoritesCount" Decode.int
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SINGLE
|
||||||
|
|
||||||
|
|
||||||
|
fetch : Maybe Cred -> Slug -> Http.Request (Article Full)
|
||||||
|
fetch maybeCred articleSlug =
|
||||||
|
let
|
||||||
|
expect =
|
||||||
|
fullDecoder maybeCred
|
||||||
|
|> Decode.field "article"
|
||||||
|
|> Http.expectJson
|
||||||
|
in
|
||||||
|
url articleSlug []
|
||||||
|
|> HttpBuilder.get
|
||||||
|
|> HttpBuilder.withExpect expect
|
||||||
|
|> Cred.addHeaderIfAvailable maybeCred
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FAVORITE
|
||||||
|
|
||||||
|
|
||||||
|
favorite : Slug -> Cred -> Http.Request (Article Preview)
|
||||||
|
favorite articleSlug cred =
|
||||||
|
buildFavorite HttpBuilder.post articleSlug cred
|
||||||
|
|
||||||
|
|
||||||
|
unfavorite : Slug -> Cred -> Http.Request (Article Preview)
|
||||||
|
unfavorite articleSlug cred =
|
||||||
|
buildFavorite HttpBuilder.delete articleSlug cred
|
||||||
|
|
||||||
|
|
||||||
|
buildFavorite :
|
||||||
|
(String -> RequestBuilder a)
|
||||||
|
-> Slug
|
||||||
|
-> Cred
|
||||||
|
-> Http.Request (Article Preview)
|
||||||
|
buildFavorite builderFromUrl articleSlug cred =
|
||||||
|
let
|
||||||
|
expect =
|
||||||
|
previewDecoder (Just cred)
|
||||||
|
|> Decode.field "article"
|
||||||
|
|> Http.expectJson
|
||||||
|
in
|
||||||
|
builderFromUrl (url articleSlug [ "favorite" ])
|
||||||
|
|> Cred.addHeader cred
|
||||||
|
|> withExpect expect
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
{-| This is a "build your own element" API.
|
||||||
|
|
||||||
|
You pass it some configuration, followed by a `List (Attribute msg)` and a
|
||||||
|
`List (Html msg)`, just like any standard Html element.
|
||||||
|
|
||||||
|
-}
|
||||||
|
favoriteButton : Cred -> msg -> List (Attribute msg) -> List (Html msg) -> Html msg
|
||||||
|
favoriteButton _ msg attrs kids =
|
||||||
|
toggleFavoriteButton "btn btn-sm btn-outline-primary" msg attrs kids
|
||||||
|
|
||||||
|
|
||||||
|
unfavoriteButton : Cred -> msg -> List (Attribute msg) -> List (Html msg) -> Html msg
|
||||||
|
unfavoriteButton _ msg attrs kids =
|
||||||
|
toggleFavoriteButton "btn btn-sm btn-primary" msg attrs kids
|
||||||
|
|
||||||
|
|
||||||
|
toggleFavoriteButton :
|
||||||
|
String
|
||||||
|
-> msg
|
||||||
|
-> List (Attribute msg)
|
||||||
|
-> List (Html msg)
|
||||||
|
-> Html msg
|
||||||
|
toggleFavoriteButton classStr msg attrs kids =
|
||||||
|
Html.button
|
||||||
|
(class classStr :: onClickStopPropagation msg :: attrs)
|
||||||
|
(i [ class "ion-heart" ] [] :: kids)
|
||||||
|
|
||||||
|
|
||||||
|
onClickStopPropagation : msg -> Attribute msg
|
||||||
|
onClickStopPropagation msg =
|
||||||
|
stopPropagationOn "click"
|
||||||
|
(Decode.succeed ( msg, True ))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- URLS
|
||||||
|
|
||||||
|
|
||||||
|
url : Slug -> List String -> String
|
||||||
|
url articleSlug paths =
|
||||||
|
allArticlesUrl (Slug.toString articleSlug :: paths)
|
||||||
|
|
||||||
|
|
||||||
|
allArticlesUrl : List String -> String
|
||||||
|
allArticlesUrl paths =
|
||||||
|
Api.url ("articles" :: paths)
|
||||||
38
intro/part5/src/Article/Body.elm
Normal file
@@ -0,0 +1,38 @@
|
|||||||
|
module Article.Body exposing (Body, MarkdownString, decoder, toHtml, toMarkdownString)
|
||||||
|
|
||||||
|
import Html exposing (Attribute, Html)
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Markdown
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Body
|
||||||
|
= Body MarkdownString
|
||||||
|
|
||||||
|
|
||||||
|
{-| Internal use only. I want to remind myself that the string inside Body contains markdown.
|
||||||
|
-}
|
||||||
|
type alias MarkdownString =
|
||||||
|
String
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- CONVERSIONS
|
||||||
|
|
||||||
|
|
||||||
|
toHtml : Body -> List (Attribute msg) -> Html msg
|
||||||
|
toHtml (Body markdown) attributes =
|
||||||
|
Markdown.toHtml attributes markdown
|
||||||
|
|
||||||
|
|
||||||
|
toMarkdownString : Body -> MarkdownString
|
||||||
|
toMarkdownString (Body markdown) =
|
||||||
|
markdown
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder Body
|
||||||
|
decoder =
|
||||||
|
Decode.map Body Decode.string
|
||||||
139
intro/part5/src/Article/Comment.elm
Normal file
@@ -0,0 +1,139 @@
|
|||||||
|
module Article.Comment
|
||||||
|
exposing
|
||||||
|
( Comment
|
||||||
|
, author
|
||||||
|
, body
|
||||||
|
, createdAt
|
||||||
|
, delete
|
||||||
|
, id
|
||||||
|
, list
|
||||||
|
, post
|
||||||
|
)
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Article exposing (Article)
|
||||||
|
import Article.Slug as Slug exposing (Slug)
|
||||||
|
import Author exposing (Author)
|
||||||
|
import CommentId exposing (CommentId)
|
||||||
|
import Http
|
||||||
|
import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Decode.Pipeline exposing (custom, required)
|
||||||
|
import Json.Encode as Encode exposing (Value)
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Time
|
||||||
|
import Timestamp
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Comment
|
||||||
|
= Comment Internals
|
||||||
|
|
||||||
|
|
||||||
|
type alias Internals =
|
||||||
|
{ id : CommentId
|
||||||
|
, body : String
|
||||||
|
, createdAt : Time.Posix
|
||||||
|
, author : Author
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INFO
|
||||||
|
|
||||||
|
|
||||||
|
id : Comment -> CommentId
|
||||||
|
id (Comment comment) =
|
||||||
|
comment.id
|
||||||
|
|
||||||
|
|
||||||
|
body : Comment -> String
|
||||||
|
body (Comment comment) =
|
||||||
|
comment.body
|
||||||
|
|
||||||
|
|
||||||
|
createdAt : Comment -> Time.Posix
|
||||||
|
createdAt (Comment comment) =
|
||||||
|
comment.createdAt
|
||||||
|
|
||||||
|
|
||||||
|
author : Comment -> Author
|
||||||
|
author (Comment comment) =
|
||||||
|
comment.author
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- LIST
|
||||||
|
|
||||||
|
|
||||||
|
list : Maybe Cred -> Slug -> Http.Request (List Comment)
|
||||||
|
list maybeCred articleSlug =
|
||||||
|
allCommentsUrl articleSlug []
|
||||||
|
|> HttpBuilder.get
|
||||||
|
|> HttpBuilder.withExpect (Http.expectJson (Decode.field "comments" (Decode.list (decoder maybeCred))))
|
||||||
|
|> Cred.addHeaderIfAvailable maybeCred
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- POST
|
||||||
|
|
||||||
|
|
||||||
|
post : Slug -> String -> Cred -> Http.Request Comment
|
||||||
|
post articleSlug commentBody cred =
|
||||||
|
allCommentsUrl articleSlug []
|
||||||
|
|> HttpBuilder.post
|
||||||
|
|> HttpBuilder.withBody (Http.jsonBody (encodeCommentBody commentBody))
|
||||||
|
|> HttpBuilder.withExpect (Http.expectJson (Decode.field "comment" (decoder (Just cred))))
|
||||||
|
|> Cred.addHeader cred
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
encodeCommentBody : String -> Value
|
||||||
|
encodeCommentBody str =
|
||||||
|
Encode.object [ ( "comment", Encode.object [ ( "body", Encode.string str ) ] ) ]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- DELETE
|
||||||
|
|
||||||
|
|
||||||
|
delete : Slug -> CommentId -> Cred -> Http.Request ()
|
||||||
|
delete articleSlug commentId cred =
|
||||||
|
commentUrl articleSlug commentId
|
||||||
|
|> HttpBuilder.delete
|
||||||
|
|> Cred.addHeader cred
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SERIALIZATION
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Maybe Cred -> Decoder Comment
|
||||||
|
decoder maybeCred =
|
||||||
|
Decode.succeed Internals
|
||||||
|
|> required "id" CommentId.decoder
|
||||||
|
|> required "body" Decode.string
|
||||||
|
|> required "createdAt" Timestamp.iso8601Decoder
|
||||||
|
|> required "author" (Author.decoder maybeCred)
|
||||||
|
|> Decode.map Comment
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- URLS
|
||||||
|
|
||||||
|
|
||||||
|
commentUrl : Slug -> CommentId -> String
|
||||||
|
commentUrl articleSlug commentId =
|
||||||
|
allCommentsUrl articleSlug [ CommentId.toString commentId ]
|
||||||
|
|
||||||
|
|
||||||
|
allCommentsUrl : Slug -> List String -> String
|
||||||
|
allCommentsUrl articleSlug paths =
|
||||||
|
Api.url ([ "articles", Slug.toString articleSlug, "comments" ] ++ paths)
|
||||||
463
intro/part5/src/Article/Feed.elm
Normal file
@@ -0,0 +1,463 @@
|
|||||||
|
module Article.Feed
|
||||||
|
exposing
|
||||||
|
( FeedConfig
|
||||||
|
, ListConfig
|
||||||
|
, Model
|
||||||
|
, Msg
|
||||||
|
, defaultFeedConfig
|
||||||
|
, defaultListConfig
|
||||||
|
, init
|
||||||
|
, selectTag
|
||||||
|
, update
|
||||||
|
, viewArticles
|
||||||
|
, viewFeedSources
|
||||||
|
)
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Article exposing (Article, Preview)
|
||||||
|
import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
|
||||||
|
import Article.Slug as ArticleSlug exposing (Slug)
|
||||||
|
import Article.Tag as Tag exposing (Tag)
|
||||||
|
import Author
|
||||||
|
import Avatar exposing (Avatar)
|
||||||
|
import Browser.Dom as Dom
|
||||||
|
import Html exposing (..)
|
||||||
|
import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src)
|
||||||
|
import Html.Events exposing (onClick)
|
||||||
|
import Http
|
||||||
|
import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams)
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Decode.Pipeline exposing (required)
|
||||||
|
import Page
|
||||||
|
import PaginatedList exposing (PaginatedList)
|
||||||
|
import Profile
|
||||||
|
import Route exposing (Route)
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Task exposing (Task)
|
||||||
|
import Time
|
||||||
|
import Timestamp
|
||||||
|
import Username exposing (Username)
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
-- MODEL
|
||||||
|
|
||||||
|
|
||||||
|
type Model
|
||||||
|
= Model InternalModel
|
||||||
|
|
||||||
|
|
||||||
|
{-| This should not be exposed! We want to benefit from the guarantee that only
|
||||||
|
this module can create or alter this model. This way if it ever ends up in
|
||||||
|
a surprising state, we know exactly where to look: this module.
|
||||||
|
-}
|
||||||
|
type alias InternalModel =
|
||||||
|
{ session : Session
|
||||||
|
, errors : List String
|
||||||
|
, articles : PaginatedList (Article Preview)
|
||||||
|
, sources : FeedSources
|
||||||
|
, isLoading : Bool
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
init : Session -> FeedSources -> Task Http.Error Model
|
||||||
|
init session sources =
|
||||||
|
let
|
||||||
|
fromArticles articles =
|
||||||
|
Model
|
||||||
|
{ session = session
|
||||||
|
, errors = []
|
||||||
|
, articles = articles
|
||||||
|
, sources = sources
|
||||||
|
, isLoading = False
|
||||||
|
}
|
||||||
|
in
|
||||||
|
FeedSources.selected sources
|
||||||
|
|> fetch (Session.cred session) 1
|
||||||
|
|> Task.map fromArticles
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
viewArticles : Time.Zone -> Model -> List (Html Msg)
|
||||||
|
viewArticles timeZone (Model { articles, sources, session }) =
|
||||||
|
let
|
||||||
|
maybeCred =
|
||||||
|
Session.cred session
|
||||||
|
|
||||||
|
articlesHtml =
|
||||||
|
PaginatedList.values articles
|
||||||
|
|> List.map (viewPreview maybeCred timeZone)
|
||||||
|
|
||||||
|
feedSource =
|
||||||
|
FeedSources.selected sources
|
||||||
|
|
||||||
|
pagination =
|
||||||
|
PaginatedList.view ClickedFeedPage articles (limit feedSource)
|
||||||
|
in
|
||||||
|
List.append articlesHtml [ pagination ]
|
||||||
|
|
||||||
|
|
||||||
|
viewPreview : Maybe Cred -> Time.Zone -> Article Preview -> Html Msg
|
||||||
|
viewPreview maybeCred timeZone article =
|
||||||
|
let
|
||||||
|
slug =
|
||||||
|
Article.slug article
|
||||||
|
|
||||||
|
{ title, description, createdAt } =
|
||||||
|
Article.metadata article
|
||||||
|
|
||||||
|
author =
|
||||||
|
Article.author article
|
||||||
|
|
||||||
|
profile =
|
||||||
|
Author.profile author
|
||||||
|
|
||||||
|
username =
|
||||||
|
Author.username author
|
||||||
|
|
||||||
|
faveButton =
|
||||||
|
case maybeCred of
|
||||||
|
Just cred ->
|
||||||
|
let
|
||||||
|
{ favoritesCount, favorited } =
|
||||||
|
Article.metadata article
|
||||||
|
|
||||||
|
viewButton =
|
||||||
|
if favorited then
|
||||||
|
Article.unfavoriteButton cred (ClickedUnfavorite cred slug)
|
||||||
|
|
||||||
|
else
|
||||||
|
Article.favoriteButton cred (ClickedFavorite cred slug)
|
||||||
|
in
|
||||||
|
viewButton [ class "pull-xs-right" ]
|
||||||
|
[ text (" " ++ String.fromInt favoritesCount) ]
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
text ""
|
||||||
|
in
|
||||||
|
div [ class "article-preview" ]
|
||||||
|
[ div [ class "article-meta" ]
|
||||||
|
[ a [ Route.href (Route.Profile username) ]
|
||||||
|
[ img [ Avatar.src (Profile.avatar profile) ] [] ]
|
||||||
|
, div [ class "info" ]
|
||||||
|
[ Author.view username
|
||||||
|
, Timestamp.view timeZone createdAt
|
||||||
|
]
|
||||||
|
, faveButton
|
||||||
|
]
|
||||||
|
, a [ class "preview-link", Route.href (Route.Article (Article.slug article)) ]
|
||||||
|
[ h1 [] [ text title ]
|
||||||
|
, p [] [ text description ]
|
||||||
|
, span [] [ text "Read more..." ]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewFeedSources : Model -> Html Msg
|
||||||
|
viewFeedSources (Model { sources, isLoading, errors }) =
|
||||||
|
let
|
||||||
|
errorsHtml =
|
||||||
|
Page.viewErrors ClickedDismissErrors errors
|
||||||
|
in
|
||||||
|
ul [ class "nav nav-pills outline-active" ] <|
|
||||||
|
List.concat
|
||||||
|
[ List.map (viewFeedSource False) (FeedSources.before sources)
|
||||||
|
, [ viewFeedSource True (FeedSources.selected sources) ]
|
||||||
|
, List.map (viewFeedSource False) (FeedSources.after sources)
|
||||||
|
, [ errorsHtml ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewFeedSource : Bool -> Source -> Html Msg
|
||||||
|
viewFeedSource isSelected source =
|
||||||
|
li [ class "nav-item" ]
|
||||||
|
[ a
|
||||||
|
[ classList [ ( "nav-link", True ), ( "active", isSelected ) ]
|
||||||
|
, onClick (ClickedFeedSource source)
|
||||||
|
|
||||||
|
-- The RealWorld CSS requires an href to work properly.
|
||||||
|
, href ""
|
||||||
|
]
|
||||||
|
[ text (sourceName source) ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
selectTag : Maybe Cred -> Tag -> Cmd Msg
|
||||||
|
selectTag maybeCred tag =
|
||||||
|
let
|
||||||
|
source =
|
||||||
|
TagFeed tag
|
||||||
|
in
|
||||||
|
fetch maybeCred 1 source
|
||||||
|
|> Task.attempt (CompletedFeedLoad source)
|
||||||
|
|
||||||
|
|
||||||
|
sourceName : Source -> String
|
||||||
|
sourceName source =
|
||||||
|
case source of
|
||||||
|
YourFeed _ ->
|
||||||
|
"Your Feed"
|
||||||
|
|
||||||
|
GlobalFeed ->
|
||||||
|
"Global Feed"
|
||||||
|
|
||||||
|
TagFeed tagName ->
|
||||||
|
"#" ++ Tag.toString tagName
|
||||||
|
|
||||||
|
FavoritedFeed username ->
|
||||||
|
"Favorited Articles"
|
||||||
|
|
||||||
|
AuthorFeed username ->
|
||||||
|
"My Articles"
|
||||||
|
|
||||||
|
|
||||||
|
limit : Source -> Int
|
||||||
|
limit feedSource =
|
||||||
|
case feedSource of
|
||||||
|
YourFeed _ ->
|
||||||
|
10
|
||||||
|
|
||||||
|
GlobalFeed ->
|
||||||
|
10
|
||||||
|
|
||||||
|
TagFeed tagName ->
|
||||||
|
10
|
||||||
|
|
||||||
|
FavoritedFeed username ->
|
||||||
|
5
|
||||||
|
|
||||||
|
AuthorFeed username ->
|
||||||
|
5
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- UPDATE
|
||||||
|
|
||||||
|
|
||||||
|
type Msg
|
||||||
|
= ClickedDismissErrors
|
||||||
|
| ClickedFavorite Cred Slug
|
||||||
|
| ClickedUnfavorite Cred Slug
|
||||||
|
| ClickedFeedPage Int
|
||||||
|
| ClickedFeedSource Source
|
||||||
|
| CompletedFavorite (Result Http.Error (Article Preview))
|
||||||
|
| CompletedFeedLoad Source (Result Http.Error (PaginatedList (Article Preview)))
|
||||||
|
|
||||||
|
|
||||||
|
update : Maybe Cred -> Msg -> Model -> ( Model, Cmd Msg )
|
||||||
|
update maybeCred msg (Model model) =
|
||||||
|
case msg of
|
||||||
|
ClickedDismissErrors ->
|
||||||
|
( Model { model | errors = [] }, Cmd.none )
|
||||||
|
|
||||||
|
ClickedFeedSource source ->
|
||||||
|
( Model { model | isLoading = True }
|
||||||
|
, source
|
||||||
|
|> fetch maybeCred 1
|
||||||
|
|> Task.attempt (CompletedFeedLoad source)
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedFeedLoad source (Ok articles) ->
|
||||||
|
( Model
|
||||||
|
{ model
|
||||||
|
| articles = articles
|
||||||
|
, sources = FeedSources.select source model.sources
|
||||||
|
, isLoading = False
|
||||||
|
}
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedFeedLoad _ (Err error) ->
|
||||||
|
( Model
|
||||||
|
{ model
|
||||||
|
| errors = Api.addServerError model.errors
|
||||||
|
, isLoading = False
|
||||||
|
}
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
ClickedFavorite cred slug ->
|
||||||
|
fave Article.favorite cred slug model
|
||||||
|
|
||||||
|
ClickedUnfavorite cred slug ->
|
||||||
|
fave Article.unfavorite cred slug model
|
||||||
|
|
||||||
|
CompletedFavorite (Ok article) ->
|
||||||
|
( Model { model | articles = PaginatedList.map (replaceArticle article) model.articles }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedFavorite (Err error) ->
|
||||||
|
( Model { model | errors = Api.addServerError model.errors }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
ClickedFeedPage page ->
|
||||||
|
let
|
||||||
|
source =
|
||||||
|
FeedSources.selected model.sources
|
||||||
|
in
|
||||||
|
( Model model
|
||||||
|
, fetch maybeCred page source
|
||||||
|
|> Task.andThen (\articles -> Task.map (\_ -> articles) scrollToTop)
|
||||||
|
|> Task.attempt (CompletedFeedLoad source)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
scrollToTop : Task x ()
|
||||||
|
scrollToTop =
|
||||||
|
Dom.setViewport 0 0
|
||||||
|
-- It's not worth showing the user anything special if scrolling fails.
|
||||||
|
-- If anything, we'd log this to an error recording service.
|
||||||
|
|> Task.onError (\_ -> Task.succeed ())
|
||||||
|
|
||||||
|
|
||||||
|
fetch : Maybe Cred -> Int -> Source -> Task Http.Error (PaginatedList (Article Preview))
|
||||||
|
fetch maybeCred page feedSource =
|
||||||
|
let
|
||||||
|
articlesPerPage =
|
||||||
|
limit feedSource
|
||||||
|
|
||||||
|
offset =
|
||||||
|
(page - 1) * articlesPerPage
|
||||||
|
|
||||||
|
listConfig =
|
||||||
|
{ defaultListConfig | offset = offset, limit = articlesPerPage }
|
||||||
|
in
|
||||||
|
Task.map (PaginatedList.mapPage (\_ -> page)) <|
|
||||||
|
case feedSource of
|
||||||
|
YourFeed cred ->
|
||||||
|
let
|
||||||
|
feedConfig =
|
||||||
|
{ defaultFeedConfig | offset = offset, limit = articlesPerPage }
|
||||||
|
in
|
||||||
|
feed feedConfig cred
|
||||||
|
|> Http.toTask
|
||||||
|
|
||||||
|
GlobalFeed ->
|
||||||
|
list listConfig maybeCred
|
||||||
|
|> Http.toTask
|
||||||
|
|
||||||
|
TagFeed tagName ->
|
||||||
|
list { listConfig | tag = Just tagName } maybeCred
|
||||||
|
|> Http.toTask
|
||||||
|
|
||||||
|
FavoritedFeed username ->
|
||||||
|
list { listConfig | favorited = Just username } maybeCred
|
||||||
|
|> Http.toTask
|
||||||
|
|
||||||
|
AuthorFeed username ->
|
||||||
|
list { listConfig | author = Just username } maybeCred
|
||||||
|
|> Http.toTask
|
||||||
|
|
||||||
|
|
||||||
|
replaceArticle : Article a -> Article a -> Article a
|
||||||
|
replaceArticle newArticle oldArticle =
|
||||||
|
if Article.slug newArticle == Article.slug oldArticle then
|
||||||
|
newArticle
|
||||||
|
|
||||||
|
else
|
||||||
|
oldArticle
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- LIST
|
||||||
|
|
||||||
|
|
||||||
|
type alias ListConfig =
|
||||||
|
{ tag : Maybe Tag
|
||||||
|
, author : Maybe Username
|
||||||
|
, favorited : Maybe Username
|
||||||
|
, limit : Int
|
||||||
|
, offset : Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
defaultListConfig : ListConfig
|
||||||
|
defaultListConfig =
|
||||||
|
{ tag = Nothing
|
||||||
|
, author = Nothing
|
||||||
|
, favorited = Nothing
|
||||||
|
, limit = 20
|
||||||
|
, offset = 0
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
list : ListConfig -> Maybe Cred -> Http.Request (PaginatedList (Article Preview))
|
||||||
|
list config maybeCred =
|
||||||
|
[ Maybe.map (\tag -> ( "tag", Tag.toString tag )) config.tag
|
||||||
|
, Maybe.map (\author -> ( "author", Username.toString author )) config.author
|
||||||
|
, Maybe.map (\favorited -> ( "favorited", Username.toString favorited )) config.favorited
|
||||||
|
, Just ( "limit", String.fromInt config.limit )
|
||||||
|
, Just ( "offset", String.fromInt config.offset )
|
||||||
|
]
|
||||||
|
|> List.filterMap identity
|
||||||
|
|> buildFromQueryParams maybeCred (Api.url [ "articles" ])
|
||||||
|
|> Cred.addHeaderIfAvailable maybeCred
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FEED
|
||||||
|
|
||||||
|
|
||||||
|
type alias FeedConfig =
|
||||||
|
{ limit : Int
|
||||||
|
, offset : Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
defaultFeedConfig : FeedConfig
|
||||||
|
defaultFeedConfig =
|
||||||
|
{ limit = 10
|
||||||
|
, offset = 0
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
feed : FeedConfig -> Cred -> Http.Request (PaginatedList (Article Preview))
|
||||||
|
feed config cred =
|
||||||
|
[ ( "limit", String.fromInt config.limit )
|
||||||
|
, ( "offset", String.fromInt config.offset )
|
||||||
|
]
|
||||||
|
|> buildFromQueryParams (Just cred) (Api.url [ "articles", "feed" ])
|
||||||
|
|> Cred.addHeader cred
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SERIALIZATION
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Maybe Cred -> Decoder (PaginatedList (Article Preview))
|
||||||
|
decoder maybeCred =
|
||||||
|
Decode.succeed PaginatedList.fromList
|
||||||
|
|> required "articlesCount" Decode.int
|
||||||
|
|> required "articles" (Decode.list (Article.previewDecoder maybeCred))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- REQUEST
|
||||||
|
|
||||||
|
|
||||||
|
buildFromQueryParams : Maybe Cred -> String -> List ( String, String ) -> RequestBuilder (PaginatedList (Article Preview))
|
||||||
|
buildFromQueryParams maybeCred url queryParams =
|
||||||
|
HttpBuilder.get url
|
||||||
|
|> withExpect (Http.expectJson (decoder maybeCred))
|
||||||
|
|> withQueryParams queryParams
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INTERNAL
|
||||||
|
|
||||||
|
|
||||||
|
fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> InternalModel -> ( Model, Cmd Msg )
|
||||||
|
fave toRequest cred slug model =
|
||||||
|
( Model model
|
||||||
|
, toRequest slug cred
|
||||||
|
|> Http.toTask
|
||||||
|
|> Task.attempt CompletedFavorite
|
||||||
|
)
|
||||||
109
intro/part5/src/Article/FeedSources.elm
Normal file
@@ -0,0 +1,109 @@
|
|||||||
|
module Article.FeedSources exposing (FeedSources, Source(..), after, before, fromLists, select, selected)
|
||||||
|
|
||||||
|
import Article
|
||||||
|
import Article.Tag as Tag exposing (Tag)
|
||||||
|
import Username exposing (Username)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type FeedSources
|
||||||
|
= FeedSources
|
||||||
|
{ before : List Source
|
||||||
|
, selected : Source
|
||||||
|
, after : List Source
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type Source
|
||||||
|
= YourFeed Cred
|
||||||
|
| GlobalFeed
|
||||||
|
| TagFeed Tag
|
||||||
|
| FavoritedFeed Username
|
||||||
|
| AuthorFeed Username
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- BUILDING
|
||||||
|
|
||||||
|
|
||||||
|
fromLists : Source -> List Source -> FeedSources
|
||||||
|
fromLists selectedSource afterSources =
|
||||||
|
FeedSources
|
||||||
|
{ before = []
|
||||||
|
, selected = selectedSource
|
||||||
|
, after = afterSources
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SELECTING
|
||||||
|
|
||||||
|
|
||||||
|
select : Source -> FeedSources -> FeedSources
|
||||||
|
select selectedSource (FeedSources sources) =
|
||||||
|
let
|
||||||
|
( newBefore, newAfter ) =
|
||||||
|
(sources.before ++ (sources.selected :: sources.after))
|
||||||
|
-- By design, tags can only be included if they're selected.
|
||||||
|
|> List.filter isNotTag
|
||||||
|
|> splitOn (\source -> source == selectedSource)
|
||||||
|
in
|
||||||
|
FeedSources
|
||||||
|
{ before = List.reverse newBefore
|
||||||
|
, selected = selectedSource
|
||||||
|
, after = List.reverse newAfter
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
splitOn : (Source -> Bool) -> List Source -> ( List Source, List Source )
|
||||||
|
splitOn isSelected sources =
|
||||||
|
let
|
||||||
|
( _, newBefore, newAfter ) =
|
||||||
|
List.foldl (splitOnHelp isSelected) ( False, [], [] ) sources
|
||||||
|
in
|
||||||
|
( newBefore, newAfter )
|
||||||
|
|
||||||
|
|
||||||
|
splitOnHelp : (Source -> Bool) -> Source -> ( Bool, List Source, List Source ) -> ( Bool, List Source, List Source )
|
||||||
|
splitOnHelp isSelected source ( foundSelected, beforeSelected, afterSelected ) =
|
||||||
|
if isSelected source then
|
||||||
|
( True, beforeSelected, afterSelected )
|
||||||
|
|
||||||
|
else if foundSelected then
|
||||||
|
( foundSelected, beforeSelected, source :: afterSelected )
|
||||||
|
|
||||||
|
else
|
||||||
|
( foundSelected, source :: beforeSelected, afterSelected )
|
||||||
|
|
||||||
|
|
||||||
|
isNotTag : Source -> Bool
|
||||||
|
isNotTag currentSource =
|
||||||
|
case currentSource of
|
||||||
|
TagFeed _ ->
|
||||||
|
False
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
True
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INFO
|
||||||
|
|
||||||
|
|
||||||
|
selected : FeedSources -> Source
|
||||||
|
selected (FeedSources record) =
|
||||||
|
record.selected
|
||||||
|
|
||||||
|
|
||||||
|
before : FeedSources -> List Source
|
||||||
|
before (FeedSources record) =
|
||||||
|
record.before
|
||||||
|
|
||||||
|
|
||||||
|
after : FeedSources -> List Source
|
||||||
|
after (FeedSources record) =
|
||||||
|
record.after
|
||||||
35
intro/part5/src/Article/Slug.elm
Normal file
@@ -0,0 +1,35 @@
|
|||||||
|
module Article.Slug exposing (Slug, decoder, toString, urlParser)
|
||||||
|
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Url.Parser exposing (Parser)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Slug
|
||||||
|
= Slug String
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- CREATE
|
||||||
|
|
||||||
|
|
||||||
|
urlParser : Parser (Slug -> a) a
|
||||||
|
urlParser =
|
||||||
|
Url.Parser.custom "SLUG" (\str -> Just (Slug str))
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder Slug
|
||||||
|
decoder =
|
||||||
|
Decode.map Slug Decode.string
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TRANSFORM
|
||||||
|
|
||||||
|
|
||||||
|
toString : Slug -> String
|
||||||
|
toString (Slug str) =
|
||||||
|
str
|
||||||
41
intro/part5/src/Article/Tag.elm
Normal file
@@ -0,0 +1,41 @@
|
|||||||
|
module Article.Tag exposing (Tag, list, toString)
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Http
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Tag
|
||||||
|
= Tag String
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TRANSFORM
|
||||||
|
|
||||||
|
|
||||||
|
toString : Tag -> String
|
||||||
|
toString (Tag slug) =
|
||||||
|
slug
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- LIST
|
||||||
|
|
||||||
|
|
||||||
|
list : Http.Request (List Tag)
|
||||||
|
list =
|
||||||
|
Decode.field "tags" (Decode.list decoder)
|
||||||
|
|> Http.get (Api.url [ "tags" ])
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SERIALIZATION
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder Tag
|
||||||
|
decoder =
|
||||||
|
Decode.map Tag Decode.string
|
||||||
48
intro/part5/src/Asset.elm
Normal file
@@ -0,0 +1,48 @@
|
|||||||
|
module Asset exposing (Image, defaultAvatar, error, loading, src)
|
||||||
|
|
||||||
|
{-| Assets, such as images, videos, and audio. (We only have images for now.)
|
||||||
|
|
||||||
|
We should never expose asset URLs directly; this module should be in charge of
|
||||||
|
all of them. One source of truth!
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Html exposing (Attribute, Html)
|
||||||
|
import Html.Attributes as Attr
|
||||||
|
|
||||||
|
|
||||||
|
type Image
|
||||||
|
= Image String
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- IMAGES
|
||||||
|
|
||||||
|
|
||||||
|
error : Image
|
||||||
|
error =
|
||||||
|
image "error.jpg"
|
||||||
|
|
||||||
|
|
||||||
|
loading : Image
|
||||||
|
loading =
|
||||||
|
image "loading.svg"
|
||||||
|
|
||||||
|
|
||||||
|
defaultAvatar : Image
|
||||||
|
defaultAvatar =
|
||||||
|
Image "smiley-cyrus.jpg"
|
||||||
|
|
||||||
|
|
||||||
|
image : String -> Image
|
||||||
|
image filename =
|
||||||
|
Image ("/assets/images/" ++ filename)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- USING IMAGES
|
||||||
|
|
||||||
|
|
||||||
|
src : Image -> Attribute msg
|
||||||
|
src (Image url) =
|
||||||
|
Attr.src url
|
||||||
251
intro/part5/src/Author.elm
Normal file
@@ -0,0 +1,251 @@
|
|||||||
|
module Author
|
||||||
|
exposing
|
||||||
|
( Author(..)
|
||||||
|
, FollowedAuthor
|
||||||
|
, UnfollowedAuthor
|
||||||
|
, decoder
|
||||||
|
, fetch
|
||||||
|
, follow
|
||||||
|
, followButton
|
||||||
|
, profile
|
||||||
|
, requestFollow
|
||||||
|
, requestUnfollow
|
||||||
|
, unfollow
|
||||||
|
, unfollowButton
|
||||||
|
, username
|
||||||
|
, view
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| The author of an Article. It includes a Profile.
|
||||||
|
|
||||||
|
I designed this to make sure the compiler would help me keep these three
|
||||||
|
possibilities straight when displaying follow buttons and such:
|
||||||
|
|
||||||
|
- I'm following this author.
|
||||||
|
- I'm not following this author.
|
||||||
|
- I _can't_ follow this author, because it's me!
|
||||||
|
|
||||||
|
To do this, I defined `Author` a custom type with three variants, one for each
|
||||||
|
of those possibilities.
|
||||||
|
|
||||||
|
I also made separate types for FollowedAuthor and UnfollowedAuthor.
|
||||||
|
They are custom type wrappers around Profile, and thier sole purpose is to
|
||||||
|
help me keep track of which operations are supported.
|
||||||
|
|
||||||
|
For example, consider these functions:
|
||||||
|
|
||||||
|
requestFollow : UnfollowedAuthor -> Cred -> Http.Request Author
|
||||||
|
requestUnfollow : FollowedAuthor -> Cred -> Http.Request Author
|
||||||
|
|
||||||
|
These types help the compiler prevent several mistakes:
|
||||||
|
|
||||||
|
- Displaying a Follow button for an author the user already follows.
|
||||||
|
- Displaying an Unfollow button for an author the user already doesn't follow.
|
||||||
|
- Displaying either button when the author is ourself.
|
||||||
|
|
||||||
|
There are still ways we could mess things up (e.g. make a button that calls Author.unfollow when you click it, but which displays "Follow" to the user) - but this rules out a bunch of potential problems.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Html exposing (Html, a, i, text)
|
||||||
|
import Html.Attributes exposing (attribute, class, href, id, placeholder)
|
||||||
|
import Html.Events exposing (onClick)
|
||||||
|
import Http
|
||||||
|
import HttpBuilder exposing (RequestBuilder, withExpect)
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Decode.Pipeline exposing (custom, required)
|
||||||
|
import Json.Encode as Encode exposing (Value)
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Route exposing (Route)
|
||||||
|
import Username exposing (Username)
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
{-| An author - either the current user, another user we're following, or
|
||||||
|
another user we aren't following.
|
||||||
|
|
||||||
|
These distinctions matter because we can only perform "follow" requests for
|
||||||
|
users we aren't following, we can only perform "unfollow" requests for
|
||||||
|
users we _are_ following, and we can't perform either for ourselves.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type Author
|
||||||
|
= IsFollowing FollowedAuthor
|
||||||
|
| IsNotFollowing UnfollowedAuthor
|
||||||
|
| IsViewer Cred Profile
|
||||||
|
|
||||||
|
|
||||||
|
{-| An author we're following.
|
||||||
|
-}
|
||||||
|
type FollowedAuthor
|
||||||
|
= FollowedAuthor Username Profile
|
||||||
|
|
||||||
|
|
||||||
|
{-| An author we're not following.
|
||||||
|
-}
|
||||||
|
type UnfollowedAuthor
|
||||||
|
= UnfollowedAuthor Username Profile
|
||||||
|
|
||||||
|
|
||||||
|
{-| Return an Author's username.
|
||||||
|
-}
|
||||||
|
username : Author -> Username
|
||||||
|
username author =
|
||||||
|
case author of
|
||||||
|
IsViewer cred _ ->
|
||||||
|
Cred.username cred
|
||||||
|
|
||||||
|
IsFollowing (FollowedAuthor val _) ->
|
||||||
|
val
|
||||||
|
|
||||||
|
IsNotFollowing (UnfollowedAuthor val _) ->
|
||||||
|
val
|
||||||
|
|
||||||
|
|
||||||
|
{-| Return an Author's profile.
|
||||||
|
-}
|
||||||
|
profile : Author -> Profile
|
||||||
|
profile author =
|
||||||
|
case author of
|
||||||
|
IsViewer _ val ->
|
||||||
|
val
|
||||||
|
|
||||||
|
IsFollowing (FollowedAuthor _ val) ->
|
||||||
|
val
|
||||||
|
|
||||||
|
IsNotFollowing (UnfollowedAuthor _ val) ->
|
||||||
|
val
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FETCH
|
||||||
|
|
||||||
|
|
||||||
|
fetch : Username -> Maybe Cred -> Http.Request Author
|
||||||
|
fetch uname maybeCred =
|
||||||
|
Api.url [ "profiles", Username.toString uname ]
|
||||||
|
|> HttpBuilder.get
|
||||||
|
|> HttpBuilder.withExpect (Http.expectJson (Decode.field "profile" (decoder maybeCred)))
|
||||||
|
|> Cred.addHeaderIfAvailable maybeCred
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FOLLOWING
|
||||||
|
|
||||||
|
|
||||||
|
follow : UnfollowedAuthor -> FollowedAuthor
|
||||||
|
follow (UnfollowedAuthor uname prof) =
|
||||||
|
FollowedAuthor uname prof
|
||||||
|
|
||||||
|
|
||||||
|
unfollow : FollowedAuthor -> UnfollowedAuthor
|
||||||
|
unfollow (FollowedAuthor uname prof) =
|
||||||
|
UnfollowedAuthor uname prof
|
||||||
|
|
||||||
|
|
||||||
|
requestFollow : UnfollowedAuthor -> Cred -> Http.Request Author
|
||||||
|
requestFollow (UnfollowedAuthor uname _) cred =
|
||||||
|
requestHelp HttpBuilder.post uname cred
|
||||||
|
|
||||||
|
|
||||||
|
requestUnfollow : FollowedAuthor -> Cred -> Http.Request Author
|
||||||
|
requestUnfollow (FollowedAuthor uname _) cred =
|
||||||
|
requestHelp HttpBuilder.delete uname cred
|
||||||
|
|
||||||
|
|
||||||
|
requestHelp :
|
||||||
|
(String -> RequestBuilder a)
|
||||||
|
-> Username
|
||||||
|
-> Cred
|
||||||
|
-> Http.Request Author
|
||||||
|
requestHelp builderFromUrl uname cred =
|
||||||
|
Api.url [ "profiles", Username.toString uname, "follow" ]
|
||||||
|
|> builderFromUrl
|
||||||
|
|> Cred.addHeader cred
|
||||||
|
|> withExpect (Http.expectJson (Decode.field "profile" (decoder Nothing)))
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
followButton : (Cred -> UnfollowedAuthor -> msg) -> Cred -> UnfollowedAuthor -> Html msg
|
||||||
|
followButton toMsg cred ((UnfollowedAuthor uname _) as author) =
|
||||||
|
toggleFollowButton "Follow"
|
||||||
|
[ "btn-outline-secondary" ]
|
||||||
|
(toMsg cred author)
|
||||||
|
uname
|
||||||
|
|
||||||
|
|
||||||
|
unfollowButton : (Cred -> FollowedAuthor -> msg) -> Cred -> FollowedAuthor -> Html msg
|
||||||
|
unfollowButton toMsg cred ((FollowedAuthor uname _) as author) =
|
||||||
|
toggleFollowButton "Unfollow"
|
||||||
|
[ "btn-secondary" ]
|
||||||
|
(toMsg cred author)
|
||||||
|
uname
|
||||||
|
|
||||||
|
|
||||||
|
toggleFollowButton : String -> List String -> msg -> Username -> Html msg
|
||||||
|
toggleFollowButton txt extraClasses msgWhenClicked uname =
|
||||||
|
let
|
||||||
|
classStr =
|
||||||
|
"btn btn-sm " ++ String.join " " extraClasses ++ " action-btn"
|
||||||
|
|
||||||
|
caption =
|
||||||
|
" " ++ txt ++ " " ++ Username.toString uname
|
||||||
|
in
|
||||||
|
Html.button [ class classStr, onClick msgWhenClicked ]
|
||||||
|
[ i [ class "ion-plus-round" ] []
|
||||||
|
, text caption
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SERIALIZATION
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Maybe Cred -> Decoder Author
|
||||||
|
decoder maybeCred =
|
||||||
|
Decode.succeed Tuple.pair
|
||||||
|
|> custom Profile.decoder
|
||||||
|
|> required "username" Username.decoder
|
||||||
|
|> Decode.andThen (decodeFromPair maybeCred)
|
||||||
|
|
||||||
|
|
||||||
|
decodeFromPair : Maybe Cred -> ( Profile, Username ) -> Decoder Author
|
||||||
|
decodeFromPair maybeCred ( prof, uname ) =
|
||||||
|
case maybeCred of
|
||||||
|
Nothing ->
|
||||||
|
-- If you're logged out, you can't be following anyone!
|
||||||
|
Decode.succeed (IsNotFollowing (UnfollowedAuthor uname prof))
|
||||||
|
|
||||||
|
Just cred ->
|
||||||
|
if uname == Cred.username cred then
|
||||||
|
Decode.succeed (IsViewer cred prof)
|
||||||
|
|
||||||
|
else
|
||||||
|
nonViewerDecoder prof uname
|
||||||
|
|
||||||
|
|
||||||
|
nonViewerDecoder : Profile -> Username -> Decoder Author
|
||||||
|
nonViewerDecoder prof uname =
|
||||||
|
Decode.field "following" Decode.bool
|
||||||
|
|> Decode.map (authorFromFollowing prof uname)
|
||||||
|
|
||||||
|
|
||||||
|
authorFromFollowing : Profile -> Username -> Bool -> Author
|
||||||
|
authorFromFollowing prof uname isFollowing =
|
||||||
|
if isFollowing then
|
||||||
|
IsFollowing (FollowedAuthor uname prof)
|
||||||
|
|
||||||
|
else
|
||||||
|
IsNotFollowing (UnfollowedAuthor uname prof)
|
||||||
|
|
||||||
|
|
||||||
|
{-| View an author. We basically render their username and a link to their
|
||||||
|
profile, and that's it.
|
||||||
|
-}
|
||||||
|
view : Username -> Html msg
|
||||||
|
view uname =
|
||||||
|
a [ class "author", Route.href (Route.Profile uname) ]
|
||||||
|
[ Username.toHtml uname ]
|
||||||
56
intro/part5/src/Avatar.elm
Normal file
@@ -0,0 +1,56 @@
|
|||||||
|
module Avatar exposing (Avatar, decoder, encode, src, toMaybeString)
|
||||||
|
|
||||||
|
import Asset
|
||||||
|
import Html exposing (Attribute)
|
||||||
|
import Html.Attributes
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Encode as Encode exposing (Value)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Avatar
|
||||||
|
= Avatar (Maybe String)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- CREATE
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder Avatar
|
||||||
|
decoder =
|
||||||
|
Decode.map Avatar (Decode.nullable Decode.string)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TRANSFORM
|
||||||
|
|
||||||
|
|
||||||
|
encode : Avatar -> Value
|
||||||
|
encode (Avatar maybeUrl) =
|
||||||
|
case maybeUrl of
|
||||||
|
Just url ->
|
||||||
|
Encode.string url
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Encode.null
|
||||||
|
|
||||||
|
|
||||||
|
src : Avatar -> Attribute msg
|
||||||
|
src (Avatar maybeUrl) =
|
||||||
|
case maybeUrl of
|
||||||
|
Nothing ->
|
||||||
|
Asset.src Asset.defaultAvatar
|
||||||
|
|
||||||
|
Just "" ->
|
||||||
|
Asset.src Asset.defaultAvatar
|
||||||
|
|
||||||
|
Just url ->
|
||||||
|
Html.Attributes.src url
|
||||||
|
|
||||||
|
|
||||||
|
toMaybeString : Avatar -> Maybe String
|
||||||
|
toMaybeString (Avatar maybeUrl) =
|
||||||
|
maybeUrl
|
||||||
29
intro/part5/src/CommentId.elm
Normal file
@@ -0,0 +1,29 @@
|
|||||||
|
module CommentId exposing (CommentId, decoder, toString)
|
||||||
|
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type CommentId
|
||||||
|
= CommentId Int
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- CREATE
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder CommentId
|
||||||
|
decoder =
|
||||||
|
Decode.map CommentId Decode.int
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TRANSFORM
|
||||||
|
|
||||||
|
|
||||||
|
toString : CommentId -> String
|
||||||
|
toString (CommentId id) =
|
||||||
|
String.fromInt id
|
||||||
45
intro/part5/src/Email.elm
Normal file
@@ -0,0 +1,45 @@
|
|||||||
|
module Email exposing (Email, decoder, encode, toString)
|
||||||
|
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Encode as Encode exposing (Value)
|
||||||
|
|
||||||
|
|
||||||
|
{-| An email address.
|
||||||
|
|
||||||
|
Having this as a custom type that's separate from String makes certain
|
||||||
|
mistakes impossible. Consider this function:
|
||||||
|
|
||||||
|
updateEmailAddress : Email -> String -> Http.Request
|
||||||
|
updateEmailAddress email password = ...
|
||||||
|
|
||||||
|
(The server needs your password to confirm that you should be allowed
|
||||||
|
to update the email address.)
|
||||||
|
|
||||||
|
Because Email is not a type alias for String, but is instead a separate
|
||||||
|
custom type, it is now impossible to mix up the argument order of the
|
||||||
|
email and the password. If we do, it won't compile!
|
||||||
|
|
||||||
|
If Email were instead defined as `type alias Email = String`, we could
|
||||||
|
call updateEmailAddress password email and it would compile (and never
|
||||||
|
work properly).
|
||||||
|
|
||||||
|
This way, we make it impossible for a bug like that to compile!
|
||||||
|
|
||||||
|
-}
|
||||||
|
type Email
|
||||||
|
= Email String
|
||||||
|
|
||||||
|
|
||||||
|
toString : Email -> String
|
||||||
|
toString (Email str) =
|
||||||
|
str
|
||||||
|
|
||||||
|
|
||||||
|
encode : Email -> Value
|
||||||
|
encode (Email str) =
|
||||||
|
Encode.string str
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder Email
|
||||||
|
decoder =
|
||||||
|
Decode.map Email Decode.string
|
||||||
25
intro/part5/src/Loading.elm
Normal file
@@ -0,0 +1,25 @@
|
|||||||
|
module Loading exposing (error, icon, slowThreshold)
|
||||||
|
|
||||||
|
{-| A loading spinner icon.
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Asset
|
||||||
|
import Html exposing (Attribute, Html)
|
||||||
|
import Html.Attributes exposing (alt, height, src, width)
|
||||||
|
import Process
|
||||||
|
import Task exposing (Task)
|
||||||
|
|
||||||
|
|
||||||
|
icon : Html msg
|
||||||
|
icon =
|
||||||
|
Html.img [ Asset.src Asset.loading, width 64, height 64, alt "Loading..." ] []
|
||||||
|
|
||||||
|
|
||||||
|
error : String -> Html msg
|
||||||
|
error str =
|
||||||
|
Html.text ("Error loading " ++ str ++ ".")
|
||||||
|
|
||||||
|
|
||||||
|
slowThreshold : Task x ()
|
||||||
|
slowThreshold =
|
||||||
|
Process.sleep 500
|
||||||
20
intro/part5/src/Log.elm
Normal file
@@ -0,0 +1,20 @@
|
|||||||
|
module Log exposing (error)
|
||||||
|
|
||||||
|
{-| This is a placeholder API for how we might do logging through
|
||||||
|
some service like <http://rollbar.com> (which is what we use at work).
|
||||||
|
|
||||||
|
Whenever you see Log.error used in this code base, it means
|
||||||
|
"Something unexpected happened. This is where we would log an
|
||||||
|
error to our server with some diagnostic info so we could investigate
|
||||||
|
what happened later."
|
||||||
|
|
||||||
|
(Since this is outside the scope of the RealWorld spec, and is only
|
||||||
|
a placeholder anyway, I didn't bother making this function accept actual
|
||||||
|
diagnostic info, authentication tokens, etc.)
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
|
error : Cmd msg
|
||||||
|
error =
|
||||||
|
Cmd.none
|
||||||
334
intro/part5/src/Main.elm
Normal file
@@ -0,0 +1,334 @@
|
|||||||
|
module Main exposing (main)
|
||||||
|
|
||||||
|
import Article.FeedSources as FeedSources
|
||||||
|
import Article.Slug exposing (Slug)
|
||||||
|
import Browser exposing (Document)
|
||||||
|
import Browser.Navigation as Nav
|
||||||
|
import Html exposing (..)
|
||||||
|
import Json.Decode as Decode exposing (Value)
|
||||||
|
import Page exposing (Page)
|
||||||
|
import Page.Article as Article
|
||||||
|
import Page.Article.Editor as Editor
|
||||||
|
import Page.Blank as Blank
|
||||||
|
import Page.Home as Home
|
||||||
|
import Page.Login as Login
|
||||||
|
import Page.NotFound as NotFound
|
||||||
|
import Page.Profile as Profile
|
||||||
|
import Page.Register as Register
|
||||||
|
import Page.Settings as Settings
|
||||||
|
import Route exposing (Route)
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Task
|
||||||
|
import Time
|
||||||
|
import Url exposing (Url)
|
||||||
|
import Username exposing (Username)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- WARNING: Based on discussions around how asset management features
|
||||||
|
-- like code splitting and lazy loading have been shaping up, I expect
|
||||||
|
-- most of this file to become unnecessary in a future release of Elm.
|
||||||
|
-- Avoid putting things in here unless there is no alternative!
|
||||||
|
|
||||||
|
|
||||||
|
type Model
|
||||||
|
= Redirect Session
|
||||||
|
| NotFound Session
|
||||||
|
| Home Home.Model
|
||||||
|
| Settings Settings.Model
|
||||||
|
| Login Login.Model
|
||||||
|
| Register Register.Model
|
||||||
|
| Profile Username Profile.Model
|
||||||
|
| Article Article.Model
|
||||||
|
| Editor (Maybe Slug) Editor.Model
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- MODEL
|
||||||
|
|
||||||
|
|
||||||
|
init : Value -> Url -> Nav.Key -> ( Model, Cmd Msg )
|
||||||
|
init flags url navKey =
|
||||||
|
changeRouteTo (Route.fromUrl url)
|
||||||
|
(Redirect (Session.decode navKey flags))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : Model -> Document Msg
|
||||||
|
view model =
|
||||||
|
let
|
||||||
|
viewPage page toMsg config =
|
||||||
|
let
|
||||||
|
{ title, body } =
|
||||||
|
Page.view (Session.viewer (toSession model)) page config
|
||||||
|
in
|
||||||
|
{ title = title
|
||||||
|
, body = List.map (Html.map toMsg) body
|
||||||
|
}
|
||||||
|
in
|
||||||
|
case model of
|
||||||
|
Redirect _ ->
|
||||||
|
viewPage Page.Other (\_ -> Ignored) Blank.view
|
||||||
|
|
||||||
|
NotFound _ ->
|
||||||
|
viewPage Page.Other (\_ -> Ignored) NotFound.view
|
||||||
|
|
||||||
|
Settings settings ->
|
||||||
|
viewPage Page.Other GotSettingsMsg (Settings.view settings)
|
||||||
|
|
||||||
|
Home home ->
|
||||||
|
viewPage Page.Home GotHomeMsg (Home.view home)
|
||||||
|
|
||||||
|
Login login ->
|
||||||
|
viewPage Page.Other GotLoginMsg (Login.view login)
|
||||||
|
|
||||||
|
Register register ->
|
||||||
|
viewPage Page.Other GotRegisterMsg (Register.view register)
|
||||||
|
|
||||||
|
Profile username profile ->
|
||||||
|
viewPage (Page.Profile username) GotProfileMsg (Profile.view profile)
|
||||||
|
|
||||||
|
Article article ->
|
||||||
|
viewPage Page.Other GotArticleMsg (Article.view article)
|
||||||
|
|
||||||
|
Editor Nothing editor ->
|
||||||
|
viewPage Page.NewArticle GotEditorMsg (Editor.view editor)
|
||||||
|
|
||||||
|
Editor (Just _) editor ->
|
||||||
|
viewPage Page.Other GotEditorMsg (Editor.view editor)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- UPDATE
|
||||||
|
|
||||||
|
|
||||||
|
type Msg
|
||||||
|
= Ignored
|
||||||
|
| ChangedRoute (Maybe Route)
|
||||||
|
| ChangedUrl Url
|
||||||
|
| ClickedLink Browser.UrlRequest
|
||||||
|
| GotHomeMsg Home.Msg
|
||||||
|
| GotSettingsMsg Settings.Msg
|
||||||
|
| GotLoginMsg Login.Msg
|
||||||
|
| GotRegisterMsg Register.Msg
|
||||||
|
| GotProfileMsg Profile.Msg
|
||||||
|
| GotArticleMsg Article.Msg
|
||||||
|
| GotEditorMsg Editor.Msg
|
||||||
|
| GotSession Session
|
||||||
|
|
||||||
|
|
||||||
|
toSession : Model -> Session
|
||||||
|
toSession page =
|
||||||
|
case page of
|
||||||
|
Redirect session ->
|
||||||
|
session
|
||||||
|
|
||||||
|
NotFound session ->
|
||||||
|
session
|
||||||
|
|
||||||
|
Home home ->
|
||||||
|
Home.toSession home
|
||||||
|
|
||||||
|
Settings settings ->
|
||||||
|
Settings.toSession settings
|
||||||
|
|
||||||
|
Login login ->
|
||||||
|
Login.toSession login
|
||||||
|
|
||||||
|
Register register ->
|
||||||
|
Register.toSession register
|
||||||
|
|
||||||
|
Profile _ profile ->
|
||||||
|
Profile.toSession profile
|
||||||
|
|
||||||
|
Article article ->
|
||||||
|
Article.toSession article
|
||||||
|
|
||||||
|
Editor _ editor ->
|
||||||
|
Editor.toSession editor
|
||||||
|
|
||||||
|
|
||||||
|
changeRouteTo : Maybe Route -> Model -> ( Model, Cmd Msg )
|
||||||
|
changeRouteTo maybeRoute model =
|
||||||
|
let
|
||||||
|
session =
|
||||||
|
toSession model
|
||||||
|
in
|
||||||
|
case maybeRoute of
|
||||||
|
Nothing ->
|
||||||
|
( NotFound session, Cmd.none )
|
||||||
|
|
||||||
|
Just Route.Root ->
|
||||||
|
( model, Route.replaceUrl (Session.navKey session) Route.Home )
|
||||||
|
|
||||||
|
Just Route.Logout ->
|
||||||
|
( model, Session.logout )
|
||||||
|
|
||||||
|
Just Route.NewArticle ->
|
||||||
|
Editor.initNew session
|
||||||
|
|> updateWith (Editor Nothing) GotEditorMsg model
|
||||||
|
|
||||||
|
Just (Route.EditArticle slug) ->
|
||||||
|
Editor.initEdit session slug
|
||||||
|
|> updateWith (Editor (Just slug)) GotEditorMsg model
|
||||||
|
|
||||||
|
Just Route.Settings ->
|
||||||
|
Settings.init session
|
||||||
|
|> updateWith Settings GotSettingsMsg model
|
||||||
|
|
||||||
|
Just Route.Home ->
|
||||||
|
Home.init session
|
||||||
|
|> updateWith Home GotHomeMsg model
|
||||||
|
|
||||||
|
Just Route.Login ->
|
||||||
|
Login.init session
|
||||||
|
|> updateWith Login GotLoginMsg model
|
||||||
|
|
||||||
|
Just Route.Register ->
|
||||||
|
Register.init session
|
||||||
|
|> updateWith Register GotRegisterMsg model
|
||||||
|
|
||||||
|
Just (Route.Profile username) ->
|
||||||
|
Profile.init session username
|
||||||
|
|> updateWith (Profile username) GotProfileMsg model
|
||||||
|
|
||||||
|
Just (Route.Article slug) ->
|
||||||
|
Article.init session slug
|
||||||
|
|> updateWith Article GotArticleMsg model
|
||||||
|
|
||||||
|
|
||||||
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||||
|
update msg model =
|
||||||
|
case ( msg, model ) of
|
||||||
|
( Ignored, _ ) ->
|
||||||
|
( model, Cmd.none )
|
||||||
|
|
||||||
|
( ClickedLink urlRequest, _ ) ->
|
||||||
|
case urlRequest of
|
||||||
|
Browser.Internal url ->
|
||||||
|
case url.fragment of
|
||||||
|
Nothing ->
|
||||||
|
-- If we got a link that didn't include a fragment,
|
||||||
|
-- it's from one of those (href "") attributes that
|
||||||
|
-- we have to include to make the RealWorld CSS work.
|
||||||
|
--
|
||||||
|
-- In an application doing path routing instead of
|
||||||
|
-- fragment-based routing, this entire
|
||||||
|
-- `case url.fragment of` expression this comment
|
||||||
|
-- is inside would be unnecessary.
|
||||||
|
( model, Cmd.none )
|
||||||
|
|
||||||
|
Just _ ->
|
||||||
|
( model
|
||||||
|
, Nav.pushUrl (Session.navKey (toSession model)) (Url.toString url)
|
||||||
|
)
|
||||||
|
|
||||||
|
Browser.External href ->
|
||||||
|
( model
|
||||||
|
, Nav.load href
|
||||||
|
)
|
||||||
|
|
||||||
|
( ChangedUrl url, _ ) ->
|
||||||
|
changeRouteTo (Route.fromUrl url) model
|
||||||
|
|
||||||
|
( ChangedRoute route, _ ) ->
|
||||||
|
changeRouteTo route model
|
||||||
|
|
||||||
|
( GotSettingsMsg subMsg, Settings settings ) ->
|
||||||
|
Settings.update subMsg settings
|
||||||
|
|> updateWith Settings GotSettingsMsg model
|
||||||
|
|
||||||
|
( GotLoginMsg subMsg, Login login ) ->
|
||||||
|
Login.update subMsg login
|
||||||
|
|> updateWith Login GotLoginMsg model
|
||||||
|
|
||||||
|
( GotRegisterMsg subMsg, Register register ) ->
|
||||||
|
Register.update subMsg register
|
||||||
|
|> updateWith Register GotRegisterMsg model
|
||||||
|
|
||||||
|
( GotHomeMsg subMsg, Home home ) ->
|
||||||
|
Home.update subMsg home
|
||||||
|
|> updateWith Home GotHomeMsg model
|
||||||
|
|
||||||
|
( GotProfileMsg subMsg, Profile username profile ) ->
|
||||||
|
Profile.update subMsg profile
|
||||||
|
|> updateWith (Profile username) GotProfileMsg model
|
||||||
|
|
||||||
|
( GotArticleMsg subMsg, Article article ) ->
|
||||||
|
Article.update subMsg article
|
||||||
|
|> updateWith Article GotArticleMsg model
|
||||||
|
|
||||||
|
( GotEditorMsg subMsg, Editor slug editor ) ->
|
||||||
|
Editor.update subMsg editor
|
||||||
|
|> updateWith (Editor slug) GotEditorMsg model
|
||||||
|
|
||||||
|
( GotSession session, Redirect _ ) ->
|
||||||
|
( Redirect session
|
||||||
|
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||||
|
)
|
||||||
|
|
||||||
|
( _, _ ) ->
|
||||||
|
-- Disregard messages that arrived for the wrong page.
|
||||||
|
( model, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
updateWith : (subModel -> Model) -> (subMsg -> Msg) -> Model -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg )
|
||||||
|
updateWith toModel toMsg model ( subModel, subCmd ) =
|
||||||
|
( toModel subModel
|
||||||
|
, Cmd.map toMsg subCmd
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SUBSCRIPTIONS
|
||||||
|
|
||||||
|
|
||||||
|
subscriptions : Model -> Sub Msg
|
||||||
|
subscriptions model =
|
||||||
|
case model of
|
||||||
|
NotFound _ ->
|
||||||
|
Sub.none
|
||||||
|
|
||||||
|
Redirect _ ->
|
||||||
|
Session.changes GotSession (Session.navKey (toSession model))
|
||||||
|
|
||||||
|
Settings settings ->
|
||||||
|
Sub.map GotSettingsMsg (Settings.subscriptions settings)
|
||||||
|
|
||||||
|
Home home ->
|
||||||
|
Sub.map GotHomeMsg (Home.subscriptions home)
|
||||||
|
|
||||||
|
Login login ->
|
||||||
|
Sub.map GotLoginMsg (Login.subscriptions login)
|
||||||
|
|
||||||
|
Register register ->
|
||||||
|
Sub.map GotRegisterMsg (Register.subscriptions register)
|
||||||
|
|
||||||
|
Profile _ profile ->
|
||||||
|
Sub.map GotProfileMsg (Profile.subscriptions profile)
|
||||||
|
|
||||||
|
Article article ->
|
||||||
|
Sub.map GotArticleMsg (Article.subscriptions article)
|
||||||
|
|
||||||
|
Editor _ editor ->
|
||||||
|
Sub.map GotEditorMsg (Editor.subscriptions editor)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- MAIN
|
||||||
|
|
||||||
|
|
||||||
|
main : Program Value Model Msg
|
||||||
|
main =
|
||||||
|
Browser.application
|
||||||
|
{ init = init
|
||||||
|
, onUrlChange = ChangedUrl
|
||||||
|
, onUrlRequest = ClickedLink
|
||||||
|
, subscriptions = subscriptions
|
||||||
|
, update = update
|
||||||
|
, view = view
|
||||||
|
}
|
||||||
159
intro/part5/src/Page.elm
Normal file
@@ -0,0 +1,159 @@
|
|||||||
|
module Page exposing (Page(..), view, viewErrors)
|
||||||
|
|
||||||
|
import Avatar
|
||||||
|
import Browser exposing (Document)
|
||||||
|
import Html exposing (Html, a, button, div, footer, i, img, li, nav, p, span, text, ul)
|
||||||
|
import Html.Attributes exposing (class, classList, href, style)
|
||||||
|
import Html.Events exposing (onClick)
|
||||||
|
import Profile
|
||||||
|
import Route exposing (Route)
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Username exposing (Username)
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determines which navbar link (if any) will be rendered as active.
|
||||||
|
|
||||||
|
Note that we don't enumerate every page here, because the navbar doesn't
|
||||||
|
have links for every page. Anything that's not part of the navbar falls
|
||||||
|
under Other.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type Page
|
||||||
|
= Other
|
||||||
|
| Home
|
||||||
|
| Login
|
||||||
|
| Register
|
||||||
|
| Settings
|
||||||
|
| Profile Username
|
||||||
|
| NewArticle
|
||||||
|
|
||||||
|
|
||||||
|
{-| Take a page's Html and frames it with a header and footer.
|
||||||
|
|
||||||
|
The caller provides the current user, so we can display in either
|
||||||
|
"signed in" (rendering username) or "signed out" mode.
|
||||||
|
|
||||||
|
isLoading is for determining whether we should show a loading spinner
|
||||||
|
in the header. (This comes up during slow page transitions.)
|
||||||
|
|
||||||
|
-}
|
||||||
|
view : Maybe Viewer -> Page -> { title : String, content : Html msg } -> Document msg
|
||||||
|
view maybeViewer page { title, content } =
|
||||||
|
{ title = title ++ " - Conduit"
|
||||||
|
, body = viewHeader page maybeViewer :: content :: [ viewFooter ]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
viewHeader : Page -> Maybe Viewer -> Html msg
|
||||||
|
viewHeader page maybeViewer =
|
||||||
|
nav [ class "navbar navbar-light" ]
|
||||||
|
[ div [ class "container" ]
|
||||||
|
[ a [ class "navbar-brand", Route.href Route.Home ]
|
||||||
|
[ text "conduit" ]
|
||||||
|
, ul [ class "nav navbar-nav pull-xs-right" ] <|
|
||||||
|
navbarLink page Route.Home [ text "Home" ]
|
||||||
|
:: viewMenu page maybeViewer
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewMenu : Page -> Maybe Viewer -> List (Html msg)
|
||||||
|
viewMenu page maybeViewer =
|
||||||
|
let
|
||||||
|
linkTo =
|
||||||
|
navbarLink page
|
||||||
|
in
|
||||||
|
case maybeViewer of
|
||||||
|
Just viewer ->
|
||||||
|
let
|
||||||
|
cred =
|
||||||
|
Viewer.cred viewer
|
||||||
|
|
||||||
|
username =
|
||||||
|
Cred.username cred
|
||||||
|
|
||||||
|
avatar =
|
||||||
|
Profile.avatar (Viewer.profile viewer)
|
||||||
|
in
|
||||||
|
[ linkTo Route.NewArticle [ i [ class "ion-compose" ] [], text " New Post" ]
|
||||||
|
, linkTo Route.Settings [ i [ class "ion-gear-a" ] [], text " Settings" ]
|
||||||
|
, linkTo
|
||||||
|
(Route.Profile username)
|
||||||
|
[ img [ class "user-pic", Avatar.src avatar ] []
|
||||||
|
, Username.toHtml username
|
||||||
|
]
|
||||||
|
, linkTo Route.Logout [ text "Sign out" ]
|
||||||
|
]
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
[ linkTo Route.Login [ text "Sign in" ]
|
||||||
|
, linkTo Route.Register [ text "Sign up" ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewFooter : Html msg
|
||||||
|
viewFooter =
|
||||||
|
footer []
|
||||||
|
[ div [ class "container" ]
|
||||||
|
[ a [ class "logo-font", href "/" ] [ text "conduit" ]
|
||||||
|
, span [ class "attribution" ]
|
||||||
|
[ text "An interactive learning project from "
|
||||||
|
, a [ href "https://thinkster.io" ] [ text "Thinkster" ]
|
||||||
|
, text ". Code & design licensed under MIT."
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
navbarLink : Page -> Route -> List (Html msg) -> Html msg
|
||||||
|
navbarLink page route linkContent =
|
||||||
|
li [ classList [ ( "nav-item", True ), ( "active", isActive page route ) ] ]
|
||||||
|
[ a [ class "nav-link", Route.href route ] linkContent ]
|
||||||
|
|
||||||
|
|
||||||
|
isActive : Page -> Route -> Bool
|
||||||
|
isActive page route =
|
||||||
|
case ( page, route ) of
|
||||||
|
( Home, Route.Home ) ->
|
||||||
|
True
|
||||||
|
|
||||||
|
( Login, Route.Login ) ->
|
||||||
|
True
|
||||||
|
|
||||||
|
( Register, Route.Register ) ->
|
||||||
|
True
|
||||||
|
|
||||||
|
( Settings, Route.Settings ) ->
|
||||||
|
True
|
||||||
|
|
||||||
|
( Profile pageUsername, Route.Profile routeUsername ) ->
|
||||||
|
pageUsername == routeUsername
|
||||||
|
|
||||||
|
( NewArticle, Route.NewArticle ) ->
|
||||||
|
True
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
False
|
||||||
|
|
||||||
|
|
||||||
|
{-| Render dismissable errors. We use this all over the place!
|
||||||
|
-}
|
||||||
|
viewErrors : msg -> List String -> Html msg
|
||||||
|
viewErrors dismissErrors errors =
|
||||||
|
if List.isEmpty errors then
|
||||||
|
Html.text ""
|
||||||
|
|
||||||
|
else
|
||||||
|
div
|
||||||
|
[ class "error-messages"
|
||||||
|
, style "position" "fixed"
|
||||||
|
, style "top" "0"
|
||||||
|
, style "background" "rgb(250, 250, 250)"
|
||||||
|
, style "padding" "20px"
|
||||||
|
, style "border" "1px solid"
|
||||||
|
]
|
||||||
|
<|
|
||||||
|
List.map (\error -> p [] [ text error ]) errors
|
||||||
|
++ [ button [ onClick dismissErrors ] [ text "Ok" ] ]
|
||||||
588
intro/part5/src/Page/Article.elm
Normal file
@@ -0,0 +1,588 @@
|
|||||||
|
module Page.Article exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||||
|
|
||||||
|
{-| Viewing an individual article.
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Article exposing (Article, Full, Preview)
|
||||||
|
import Article.Body exposing (Body)
|
||||||
|
import Article.Comment as Comment exposing (Comment)
|
||||||
|
import Article.Slug as Slug exposing (Slug)
|
||||||
|
import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor)
|
||||||
|
import Avatar
|
||||||
|
import Browser.Navigation as Nav
|
||||||
|
import CommentId exposing (CommentId)
|
||||||
|
import Html exposing (..)
|
||||||
|
import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder)
|
||||||
|
import Html.Events exposing (onClick, onInput, onSubmit)
|
||||||
|
import Http
|
||||||
|
import HttpBuilder exposing (RequestBuilder, withBody, withExpect, withQueryParams)
|
||||||
|
import Loading
|
||||||
|
import Log
|
||||||
|
import Page
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Route
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Task exposing (Task)
|
||||||
|
import Time
|
||||||
|
import Timestamp
|
||||||
|
import Username exposing (Username)
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- MODEL
|
||||||
|
|
||||||
|
|
||||||
|
type alias Model =
|
||||||
|
{ session : Session
|
||||||
|
, timeZone : Time.Zone
|
||||||
|
, errors : List String
|
||||||
|
|
||||||
|
-- Loaded independently from server
|
||||||
|
, comments : Status ( CommentText, List Comment )
|
||||||
|
, article : Status (Article Full)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type Status a
|
||||||
|
= Loading
|
||||||
|
| LoadingSlowly
|
||||||
|
| Loaded a
|
||||||
|
| Failed
|
||||||
|
|
||||||
|
|
||||||
|
type CommentText
|
||||||
|
= Editing String
|
||||||
|
| Sending String
|
||||||
|
|
||||||
|
|
||||||
|
init : Session -> Slug -> ( Model, Cmd Msg )
|
||||||
|
init session slug =
|
||||||
|
let
|
||||||
|
maybeCred =
|
||||||
|
Session.cred session
|
||||||
|
in
|
||||||
|
( { session = session
|
||||||
|
, timeZone = Time.utc
|
||||||
|
, errors = []
|
||||||
|
, comments = Loading
|
||||||
|
, article = Loading
|
||||||
|
}
|
||||||
|
, Cmd.batch
|
||||||
|
[ Article.fetch maybeCred slug
|
||||||
|
|> Http.send CompletedLoadArticle
|
||||||
|
, Comment.list maybeCred slug
|
||||||
|
|> Http.send CompletedLoadComments
|
||||||
|
, Task.perform GotTimeZone Time.here
|
||||||
|
, Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : Model -> { title : String, content : Html Msg }
|
||||||
|
view model =
|
||||||
|
case model.article of
|
||||||
|
Loaded article ->
|
||||||
|
let
|
||||||
|
{ title } =
|
||||||
|
Article.metadata article
|
||||||
|
|
||||||
|
author =
|
||||||
|
Article.author article
|
||||||
|
|
||||||
|
avatar =
|
||||||
|
Profile.avatar (Author.profile author)
|
||||||
|
|
||||||
|
slug =
|
||||||
|
Article.slug article
|
||||||
|
|
||||||
|
profile =
|
||||||
|
Author.profile author
|
||||||
|
|
||||||
|
buttons =
|
||||||
|
case Session.cred model.session of
|
||||||
|
Just cred ->
|
||||||
|
viewButtons cred article author
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
[]
|
||||||
|
in
|
||||||
|
{ title = title
|
||||||
|
, content =
|
||||||
|
div [ class "article-page" ]
|
||||||
|
[ div [ class "banner" ]
|
||||||
|
[ div [ class "container" ]
|
||||||
|
[ h1 [] [ text title ]
|
||||||
|
, div [ class "article-meta" ] <|
|
||||||
|
List.append
|
||||||
|
[ a [ Route.href (Route.Profile (Author.username author)) ]
|
||||||
|
[ img [ Avatar.src (Profile.avatar profile) ] [] ]
|
||||||
|
, div [ class "info" ]
|
||||||
|
[ Author.view (Author.username author)
|
||||||
|
, Timestamp.view model.timeZone (Article.metadata article).createdAt
|
||||||
|
]
|
||||||
|
]
|
||||||
|
buttons
|
||||||
|
, Page.viewErrors ClickedDismissErrors model.errors
|
||||||
|
]
|
||||||
|
]
|
||||||
|
, div [ class "container page" ]
|
||||||
|
[ div [ class "row article-content" ]
|
||||||
|
[ div [ class "col-md-12" ]
|
||||||
|
[ Article.Body.toHtml (Article.body article) [] ]
|
||||||
|
]
|
||||||
|
, hr [] []
|
||||||
|
, div [ class "article-actions" ]
|
||||||
|
[ div [ class "article-meta" ] <|
|
||||||
|
List.append
|
||||||
|
[ a [ Route.href (Route.Profile (Author.username author)) ]
|
||||||
|
[ img [ Avatar.src avatar ] [] ]
|
||||||
|
, div [ class "info" ]
|
||||||
|
[ Author.view (Author.username author)
|
||||||
|
, Timestamp.view model.timeZone (Article.metadata article).createdAt
|
||||||
|
]
|
||||||
|
]
|
||||||
|
buttons
|
||||||
|
]
|
||||||
|
, div [ class "row" ]
|
||||||
|
[ div [ class "col-xs-12 col-md-8 offset-md-2" ] <|
|
||||||
|
-- Don't render the comments until the article has loaded!
|
||||||
|
case model.comments of
|
||||||
|
Loading ->
|
||||||
|
[]
|
||||||
|
|
||||||
|
LoadingSlowly ->
|
||||||
|
[ Loading.icon ]
|
||||||
|
|
||||||
|
Loaded ( commentText, comments ) ->
|
||||||
|
-- Don't let users add comments until they can
|
||||||
|
-- see the existing comments! Otherwise you
|
||||||
|
-- may be about to repeat something that's
|
||||||
|
-- already been said.
|
||||||
|
viewAddComment slug commentText (Session.viewer model.session)
|
||||||
|
:: List.map (viewComment model.timeZone slug) comments
|
||||||
|
|
||||||
|
Failed ->
|
||||||
|
[ Loading.error "comments" ]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
Loading ->
|
||||||
|
{ title = "Article", content = text "" }
|
||||||
|
|
||||||
|
LoadingSlowly ->
|
||||||
|
{ title = "Article", content = Loading.icon }
|
||||||
|
|
||||||
|
Failed ->
|
||||||
|
{ title = "Article", content = Loading.error "article" }
|
||||||
|
|
||||||
|
|
||||||
|
viewAddComment : Slug -> CommentText -> Maybe Viewer -> Html Msg
|
||||||
|
viewAddComment slug commentText maybeViewer =
|
||||||
|
case maybeViewer of
|
||||||
|
Just viewer ->
|
||||||
|
let
|
||||||
|
avatar =
|
||||||
|
Profile.avatar (Viewer.profile viewer)
|
||||||
|
|
||||||
|
cred =
|
||||||
|
Viewer.cred viewer
|
||||||
|
|
||||||
|
( commentStr, buttonAttrs ) =
|
||||||
|
case commentText of
|
||||||
|
Editing str ->
|
||||||
|
( str, [] )
|
||||||
|
|
||||||
|
Sending str ->
|
||||||
|
( str, [ disabled True ] )
|
||||||
|
in
|
||||||
|
Html.form [ class "card comment-form", onSubmit (ClickedPostComment cred slug) ]
|
||||||
|
[ div [ class "card-block" ]
|
||||||
|
[ textarea
|
||||||
|
[ class "form-control"
|
||||||
|
, placeholder "Write a comment..."
|
||||||
|
, attribute "rows" "3"
|
||||||
|
, onInput EnteredCommentText
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, div [ class "card-footer" ]
|
||||||
|
[ img [ class "comment-author-img", Avatar.src avatar ] []
|
||||||
|
, button
|
||||||
|
(class "btn btn-sm btn-primary" :: buttonAttrs)
|
||||||
|
[ text "Post Comment" ]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
p []
|
||||||
|
[ a [ Route.href Route.Login ] [ text "Sign in" ]
|
||||||
|
, text " or "
|
||||||
|
, a [ Route.href Route.Register ] [ text "sign up" ]
|
||||||
|
, text " to comment."
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewButtons : Cred -> Article Full -> Author -> List (Html Msg)
|
||||||
|
viewButtons cred article author =
|
||||||
|
case author of
|
||||||
|
IsFollowing followedAuthor ->
|
||||||
|
[ Author.unfollowButton ClickedUnfollow cred followedAuthor
|
||||||
|
, text " "
|
||||||
|
, favoriteButton cred article
|
||||||
|
]
|
||||||
|
|
||||||
|
IsNotFollowing unfollowedAuthor ->
|
||||||
|
[ Author.followButton ClickedFollow cred unfollowedAuthor
|
||||||
|
, text " "
|
||||||
|
, favoriteButton cred article
|
||||||
|
]
|
||||||
|
|
||||||
|
IsViewer _ _ ->
|
||||||
|
[ editButton article
|
||||||
|
, text " "
|
||||||
|
, deleteButton cred article
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewComment : Time.Zone -> Slug -> Comment -> Html Msg
|
||||||
|
viewComment timeZone slug comment =
|
||||||
|
let
|
||||||
|
author =
|
||||||
|
Comment.author comment
|
||||||
|
|
||||||
|
profile =
|
||||||
|
Author.profile author
|
||||||
|
|
||||||
|
authorUsername =
|
||||||
|
Author.username author
|
||||||
|
|
||||||
|
deleteCommentButton =
|
||||||
|
case author of
|
||||||
|
IsViewer cred _ ->
|
||||||
|
let
|
||||||
|
msg =
|
||||||
|
ClickedDeleteComment cred slug (Comment.id comment)
|
||||||
|
in
|
||||||
|
span
|
||||||
|
[ class "mod-options"
|
||||||
|
, onClick msg
|
||||||
|
]
|
||||||
|
[ i [ class "ion-trash-a" ] [] ]
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
-- You can't delete other peoples' comments!
|
||||||
|
text ""
|
||||||
|
|
||||||
|
timestamp =
|
||||||
|
Timestamp.format timeZone (Comment.createdAt comment)
|
||||||
|
in
|
||||||
|
div [ class "card" ]
|
||||||
|
[ div [ class "card-block" ]
|
||||||
|
[ p [ class "card-text" ] [ text (Comment.body comment) ] ]
|
||||||
|
, div [ class "card-footer" ]
|
||||||
|
[ a [ class "comment-author", href "" ]
|
||||||
|
[ img [ class "comment-author-img", Avatar.src (Profile.avatar profile) ] []
|
||||||
|
, text " "
|
||||||
|
]
|
||||||
|
, text " "
|
||||||
|
, a [ class "comment-author", Route.href (Route.Profile authorUsername) ]
|
||||||
|
[ text (Username.toString authorUsername) ]
|
||||||
|
, span [ class "date-posted" ] [ text timestamp ]
|
||||||
|
, deleteCommentButton
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- UPDATE
|
||||||
|
|
||||||
|
|
||||||
|
type Msg
|
||||||
|
= ClickedDeleteArticle Cred Slug
|
||||||
|
| ClickedDeleteComment Cred Slug CommentId
|
||||||
|
| ClickedDismissErrors
|
||||||
|
| ClickedFavorite Cred Slug Body
|
||||||
|
| ClickedUnfavorite Cred Slug Body
|
||||||
|
| ClickedFollow Cred UnfollowedAuthor
|
||||||
|
| ClickedUnfollow Cred FollowedAuthor
|
||||||
|
| ClickedPostComment Cred Slug
|
||||||
|
| EnteredCommentText String
|
||||||
|
| CompletedLoadArticle (Result Http.Error (Article Full))
|
||||||
|
| CompletedLoadComments (Result Http.Error (List Comment))
|
||||||
|
| CompletedDeleteArticle (Result Http.Error ())
|
||||||
|
| CompletedDeleteComment CommentId (Result Http.Error ())
|
||||||
|
| CompletedFavoriteChange (Result Http.Error (Article Full))
|
||||||
|
| CompletedFollowChange (Result Http.Error Author)
|
||||||
|
| CompletedPostComment (Result Http.Error Comment)
|
||||||
|
| GotTimeZone Time.Zone
|
||||||
|
| GotSession Session
|
||||||
|
| PassedSlowLoadThreshold
|
||||||
|
|
||||||
|
|
||||||
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||||
|
update msg model =
|
||||||
|
case msg of
|
||||||
|
ClickedDismissErrors ->
|
||||||
|
( { model | errors = [] }, Cmd.none )
|
||||||
|
|
||||||
|
ClickedFavorite cred slug body ->
|
||||||
|
( model, fave Article.favorite cred slug body )
|
||||||
|
|
||||||
|
ClickedUnfavorite cred slug body ->
|
||||||
|
( model, fave Article.unfavorite cred slug body )
|
||||||
|
|
||||||
|
CompletedLoadArticle (Ok article) ->
|
||||||
|
( { model | article = Loaded article }, Cmd.none )
|
||||||
|
|
||||||
|
CompletedLoadArticle (Err error) ->
|
||||||
|
( { model | article = Failed }
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedLoadComments (Ok comments) ->
|
||||||
|
( { model | comments = Loaded ( Editing "", comments ) }, Cmd.none )
|
||||||
|
|
||||||
|
CompletedLoadComments (Err error) ->
|
||||||
|
( { model | article = Failed }, Log.error )
|
||||||
|
|
||||||
|
CompletedFavoriteChange (Ok newArticle) ->
|
||||||
|
( { model | article = Loaded newArticle }, Cmd.none )
|
||||||
|
|
||||||
|
CompletedFavoriteChange (Err error) ->
|
||||||
|
( { model | errors = Api.addServerError model.errors }
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
ClickedUnfollow cred followedAuthor ->
|
||||||
|
( model
|
||||||
|
, Author.requestUnfollow followedAuthor cred
|
||||||
|
|> Http.send CompletedFollowChange
|
||||||
|
)
|
||||||
|
|
||||||
|
ClickedFollow cred unfollowedAuthor ->
|
||||||
|
( model
|
||||||
|
, Author.requestFollow unfollowedAuthor cred
|
||||||
|
|> Http.send CompletedFollowChange
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedFollowChange (Ok newAuthor) ->
|
||||||
|
case model.article of
|
||||||
|
Loaded article ->
|
||||||
|
( { model | article = Loaded (Article.mapAuthor (\_ -> newAuthor) article) }, Cmd.none )
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
CompletedFollowChange (Err error) ->
|
||||||
|
( { model | errors = Api.addServerError model.errors }
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
EnteredCommentText str ->
|
||||||
|
case model.comments of
|
||||||
|
Loaded ( Editing _, comments ) ->
|
||||||
|
-- You can only edit comment text once comments have loaded
|
||||||
|
-- successfully, and when the comment is not currently
|
||||||
|
-- being submitted.
|
||||||
|
( { model | comments = Loaded ( Editing str, comments ) }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
ClickedPostComment cred slug ->
|
||||||
|
case model.comments of
|
||||||
|
Loaded ( Editing "", comments ) ->
|
||||||
|
-- No posting empty comments!
|
||||||
|
-- We don't use Log.error here because this isn't an error,
|
||||||
|
-- it just doesn't do anything.
|
||||||
|
( model, Cmd.none )
|
||||||
|
|
||||||
|
Loaded ( Editing str, comments ) ->
|
||||||
|
( { model | comments = Loaded ( Sending str, comments ) }
|
||||||
|
, cred
|
||||||
|
|> Comment.post slug str
|
||||||
|
|> Http.send CompletedPostComment
|
||||||
|
)
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
-- Either we have no comment to post, or there's already
|
||||||
|
-- one in the process of being posted, or we don't have
|
||||||
|
-- a valid article, in which case how did we post this?
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
CompletedPostComment (Ok comment) ->
|
||||||
|
case model.comments of
|
||||||
|
Loaded ( _, comments ) ->
|
||||||
|
( { model | comments = Loaded ( Editing "", comment :: comments ) }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
CompletedPostComment (Err error) ->
|
||||||
|
( { model | errors = Api.addServerError model.errors }
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
ClickedDeleteComment cred slug id ->
|
||||||
|
( model
|
||||||
|
, cred
|
||||||
|
|> Comment.delete slug id
|
||||||
|
|> Http.send (CompletedDeleteComment id)
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedDeleteComment id (Ok ()) ->
|
||||||
|
case model.comments of
|
||||||
|
Loaded ( commentText, comments ) ->
|
||||||
|
( { model | comments = Loaded ( commentText, withoutComment id comments ) }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
CompletedDeleteComment id (Err error) ->
|
||||||
|
( { model | errors = Api.addServerError model.errors }
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
ClickedDeleteArticle cred slug ->
|
||||||
|
( model
|
||||||
|
, delete slug cred
|
||||||
|
|> Http.send CompletedDeleteArticle
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedDeleteArticle (Ok ()) ->
|
||||||
|
( model, Route.replaceUrl (Session.navKey model.session) Route.Home )
|
||||||
|
|
||||||
|
CompletedDeleteArticle (Err error) ->
|
||||||
|
( { model | errors = Api.addServerError model.errors }
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
GotTimeZone tz ->
|
||||||
|
( { model | timeZone = tz }, Cmd.none )
|
||||||
|
|
||||||
|
GotSession session ->
|
||||||
|
( { model | session = session }
|
||||||
|
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||||
|
)
|
||||||
|
|
||||||
|
PassedSlowLoadThreshold ->
|
||||||
|
let
|
||||||
|
-- If any data is still Loading, change it to LoadingSlowly
|
||||||
|
-- so `view` knows to render a spinner.
|
||||||
|
article =
|
||||||
|
case model.article of
|
||||||
|
Loading ->
|
||||||
|
LoadingSlowly
|
||||||
|
|
||||||
|
other ->
|
||||||
|
other
|
||||||
|
|
||||||
|
comments =
|
||||||
|
case model.comments of
|
||||||
|
Loading ->
|
||||||
|
LoadingSlowly
|
||||||
|
|
||||||
|
other ->
|
||||||
|
other
|
||||||
|
in
|
||||||
|
( { model | article = article, comments = comments }, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SUBSCRIPTIONS
|
||||||
|
|
||||||
|
|
||||||
|
subscriptions : Model -> Sub Msg
|
||||||
|
subscriptions model =
|
||||||
|
Session.changes GotSession (Session.navKey model.session)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- HTTP
|
||||||
|
|
||||||
|
|
||||||
|
delete : Slug -> Cred -> Http.Request ()
|
||||||
|
delete slug cred =
|
||||||
|
Article.url slug []
|
||||||
|
|> HttpBuilder.delete
|
||||||
|
|> Cred.addHeader cred
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- EXPORT
|
||||||
|
|
||||||
|
|
||||||
|
toSession : Model -> Session
|
||||||
|
toSession model =
|
||||||
|
model.session
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INTERNAL
|
||||||
|
|
||||||
|
|
||||||
|
fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> Body -> Cmd Msg
|
||||||
|
fave toRequest cred slug body =
|
||||||
|
toRequest slug cred
|
||||||
|
|> Http.toTask
|
||||||
|
|> Task.map (Article.fromPreview body)
|
||||||
|
|> Task.attempt CompletedFavoriteChange
|
||||||
|
|
||||||
|
|
||||||
|
withoutComment : CommentId -> List Comment -> List Comment
|
||||||
|
withoutComment id list =
|
||||||
|
List.filter (\comment -> Comment.id comment /= id) list
|
||||||
|
|
||||||
|
|
||||||
|
favoriteButton : Cred -> Article Full -> Html Msg
|
||||||
|
favoriteButton cred article =
|
||||||
|
let
|
||||||
|
{ favoritesCount, favorited } =
|
||||||
|
Article.metadata article
|
||||||
|
|
||||||
|
slug =
|
||||||
|
Article.slug article
|
||||||
|
|
||||||
|
body =
|
||||||
|
Article.body article
|
||||||
|
|
||||||
|
kids =
|
||||||
|
[ text (" Favorite Article (" ++ String.fromInt favoritesCount ++ ")") ]
|
||||||
|
in
|
||||||
|
if favorited then
|
||||||
|
Article.unfavoriteButton cred (ClickedUnfavorite cred slug body) [] kids
|
||||||
|
|
||||||
|
else
|
||||||
|
Article.favoriteButton cred (ClickedFavorite cred slug body) [] kids
|
||||||
|
|
||||||
|
|
||||||
|
deleteButton : Cred -> Article a -> Html Msg
|
||||||
|
deleteButton cred article =
|
||||||
|
let
|
||||||
|
msg =
|
||||||
|
ClickedDeleteArticle cred (Article.slug article)
|
||||||
|
in
|
||||||
|
button [ class "btn btn-outline-danger btn-sm", onClick msg ]
|
||||||
|
[ i [ class "ion-trash-a" ] [], text " Delete Article" ]
|
||||||
|
|
||||||
|
|
||||||
|
editButton : Article a -> Html Msg
|
||||||
|
editButton article =
|
||||||
|
a [ class "btn btn-outline-secondary btn-sm", Route.href (Route.EditArticle (Article.slug article)) ]
|
||||||
|
[ i [ class "ion-edit" ] [], text " Edit Article" ]
|
||||||
621
intro/part5/src/Page/Article/Editor.elm
Normal file
@@ -0,0 +1,621 @@
|
|||||||
|
module Page.Article.Editor exposing (Model, Msg, initEdit, initNew, subscriptions, toSession, update, view)
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Article exposing (Article, Full)
|
||||||
|
import Article.Body exposing (Body)
|
||||||
|
import Article.Slug as Slug exposing (Slug)
|
||||||
|
import Browser.Navigation as Nav
|
||||||
|
import Html exposing (..)
|
||||||
|
import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder, type_, value)
|
||||||
|
import Html.Events exposing (onInput, onSubmit)
|
||||||
|
import Http
|
||||||
|
import HttpBuilder exposing (withBody, withExpect)
|
||||||
|
import Json.Decode as Decode
|
||||||
|
import Json.Encode as Encode
|
||||||
|
import Loading
|
||||||
|
import Page
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Route
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Task exposing (Task)
|
||||||
|
import Time
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- MODEL
|
||||||
|
|
||||||
|
|
||||||
|
type alias Model =
|
||||||
|
{ session : Session
|
||||||
|
, status : Status
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
Status
|
||||||
|
-- Edit Article
|
||||||
|
= Loading Slug
|
||||||
|
| LoadingSlowly Slug
|
||||||
|
| LoadingFailed Slug
|
||||||
|
| Saving Slug Form
|
||||||
|
| Editing Slug (List Problem) Form
|
||||||
|
-- New Article
|
||||||
|
| EditingNew (List Problem) Form
|
||||||
|
| Creating Form
|
||||||
|
|
||||||
|
|
||||||
|
type Problem
|
||||||
|
= InvalidEntry ValidatedField String
|
||||||
|
| ServerError String
|
||||||
|
|
||||||
|
|
||||||
|
type alias Form =
|
||||||
|
{ title : String
|
||||||
|
, body : String
|
||||||
|
, description : String
|
||||||
|
, tags : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
initNew : Session -> ( Model, Cmd msg )
|
||||||
|
initNew session =
|
||||||
|
( { session = session
|
||||||
|
, status =
|
||||||
|
EditingNew []
|
||||||
|
{ title = ""
|
||||||
|
, body = ""
|
||||||
|
, description = ""
|
||||||
|
, tags = ""
|
||||||
|
}
|
||||||
|
}
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
initEdit : Session -> Slug -> ( Model, Cmd Msg )
|
||||||
|
initEdit session slug =
|
||||||
|
( { session = session
|
||||||
|
, status = Loading slug
|
||||||
|
}
|
||||||
|
, Cmd.batch
|
||||||
|
[ Article.fetch (Session.cred session) slug
|
||||||
|
|> Http.toTask
|
||||||
|
-- If init fails, store the slug that failed in the msg, so we can
|
||||||
|
-- at least have it later to display the page's title properly!
|
||||||
|
|> Task.mapError (\httpError -> ( slug, httpError ))
|
||||||
|
|> Task.attempt CompletedArticleLoad
|
||||||
|
, Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : Model -> { title : String, content : Html Msg }
|
||||||
|
view model =
|
||||||
|
{ title =
|
||||||
|
case getSlug model.status of
|
||||||
|
Just slug ->
|
||||||
|
"Edit Article - " ++ Slug.toString slug
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
"New Article"
|
||||||
|
, content =
|
||||||
|
case Session.cred model.session of
|
||||||
|
Just cred ->
|
||||||
|
viewAuthenticated cred model
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
text "Sign in to edit this article."
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
viewProblems : List Problem -> Html msg
|
||||||
|
viewProblems problems =
|
||||||
|
ul [ class "error-messages" ]
|
||||||
|
(List.map viewProblem problems)
|
||||||
|
|
||||||
|
|
||||||
|
viewProblem : Problem -> Html msg
|
||||||
|
viewProblem problem =
|
||||||
|
let
|
||||||
|
errorMessage =
|
||||||
|
case problem of
|
||||||
|
InvalidEntry _ message ->
|
||||||
|
message
|
||||||
|
|
||||||
|
ServerError message ->
|
||||||
|
message
|
||||||
|
in
|
||||||
|
li [] [ text errorMessage ]
|
||||||
|
|
||||||
|
|
||||||
|
viewAuthenticated : Cred -> Model -> Html Msg
|
||||||
|
viewAuthenticated cred model =
|
||||||
|
let
|
||||||
|
formHtml =
|
||||||
|
case model.status of
|
||||||
|
Loading _ ->
|
||||||
|
[]
|
||||||
|
|
||||||
|
LoadingSlowly _ ->
|
||||||
|
[ Loading.icon ]
|
||||||
|
|
||||||
|
Saving slug form ->
|
||||||
|
[ viewForm cred form (editArticleSaveButton [ disabled True ]) ]
|
||||||
|
|
||||||
|
Creating form ->
|
||||||
|
[ viewForm cred form (newArticleSaveButton [ disabled True ]) ]
|
||||||
|
|
||||||
|
Editing slug problems form ->
|
||||||
|
[ viewProblems problems
|
||||||
|
, viewForm cred form (editArticleSaveButton [])
|
||||||
|
]
|
||||||
|
|
||||||
|
EditingNew problems form ->
|
||||||
|
[ viewProblems problems
|
||||||
|
, viewForm cred form (newArticleSaveButton [])
|
||||||
|
]
|
||||||
|
|
||||||
|
LoadingFailed _ ->
|
||||||
|
[ text "Article failed to load." ]
|
||||||
|
in
|
||||||
|
div [ class "editor-page" ]
|
||||||
|
[ div [ class "container page" ]
|
||||||
|
[ div [ class "row" ]
|
||||||
|
[ div [ class "col-md-10 offset-md-1 col-xs-12" ]
|
||||||
|
formHtml
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewForm : Cred -> Form -> Html Msg -> Html Msg
|
||||||
|
viewForm cred fields saveButton =
|
||||||
|
Html.form [ onSubmit (ClickedSave cred) ]
|
||||||
|
[ fieldset []
|
||||||
|
[ fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, placeholder "Article Title"
|
||||||
|
, onInput EnteredTitle
|
||||||
|
, value fields.title
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control"
|
||||||
|
, placeholder "What's this article about?"
|
||||||
|
, onInput EnteredDescription
|
||||||
|
, value fields.description
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ textarea
|
||||||
|
[ class "form-control"
|
||||||
|
, placeholder "Write your article (in markdown)"
|
||||||
|
, attribute "rows" "8"
|
||||||
|
, onInput EnteredBody
|
||||||
|
, value fields.body
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control"
|
||||||
|
, placeholder "Enter tags"
|
||||||
|
, onInput EnteredTags
|
||||||
|
, value fields.tags
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, saveButton
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
editArticleSaveButton : List (Attribute msg) -> Html msg
|
||||||
|
editArticleSaveButton extraAttrs =
|
||||||
|
saveArticleButton "Update Article" extraAttrs
|
||||||
|
|
||||||
|
|
||||||
|
newArticleSaveButton : List (Attribute msg) -> Html msg
|
||||||
|
newArticleSaveButton extraAttrs =
|
||||||
|
saveArticleButton "Publish Article" extraAttrs
|
||||||
|
|
||||||
|
|
||||||
|
saveArticleButton : String -> List (Attribute msg) -> Html msg
|
||||||
|
saveArticleButton caption extraAttrs =
|
||||||
|
button (class "btn btn-lg pull-xs-right btn-primary" :: extraAttrs)
|
||||||
|
[ text caption ]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- UPDATE
|
||||||
|
|
||||||
|
|
||||||
|
type Msg
|
||||||
|
= ClickedSave Cred
|
||||||
|
| EnteredBody String
|
||||||
|
| EnteredDescription String
|
||||||
|
| EnteredTags String
|
||||||
|
| EnteredTitle String
|
||||||
|
| CompletedCreate (Result Http.Error (Article Full))
|
||||||
|
| CompletedEdit (Result Http.Error (Article Full))
|
||||||
|
| CompletedArticleLoad (Result ( Slug, Http.Error ) (Article Full))
|
||||||
|
| GotSession Session
|
||||||
|
| PassedSlowLoadThreshold
|
||||||
|
|
||||||
|
|
||||||
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||||
|
update msg model =
|
||||||
|
case msg of
|
||||||
|
ClickedSave cred ->
|
||||||
|
model.status
|
||||||
|
|> save cred
|
||||||
|
|> Tuple.mapFirst (\status -> { model | status = status })
|
||||||
|
|
||||||
|
EnteredTitle title ->
|
||||||
|
updateForm (\form -> { form | title = title }) model
|
||||||
|
|
||||||
|
EnteredDescription description ->
|
||||||
|
updateForm (\form -> { form | description = description }) model
|
||||||
|
|
||||||
|
EnteredTags tags ->
|
||||||
|
updateForm (\form -> { form | tags = tags }) model
|
||||||
|
|
||||||
|
EnteredBody body ->
|
||||||
|
updateForm (\form -> { form | body = body }) model
|
||||||
|
|
||||||
|
CompletedCreate (Ok article) ->
|
||||||
|
( model
|
||||||
|
, Route.Article (Article.slug article)
|
||||||
|
|> Route.replaceUrl (Session.navKey model.session)
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedCreate (Err error) ->
|
||||||
|
( { model | status = savingError error model.status }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedEdit (Ok article) ->
|
||||||
|
( model
|
||||||
|
, Route.Article (Article.slug article)
|
||||||
|
|> Route.replaceUrl (Session.navKey model.session)
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedEdit (Err error) ->
|
||||||
|
( { model | status = savingError error model.status }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedArticleLoad (Err ( slug, error )) ->
|
||||||
|
( { model | status = LoadingFailed slug }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedArticleLoad (Ok article) ->
|
||||||
|
let
|
||||||
|
{ title, description, tags } =
|
||||||
|
Article.metadata article
|
||||||
|
|
||||||
|
status =
|
||||||
|
Editing (Article.slug article)
|
||||||
|
[]
|
||||||
|
{ title = title
|
||||||
|
, body = Article.Body.toMarkdownString (Article.body article)
|
||||||
|
, description = description
|
||||||
|
, tags = String.join " " tags
|
||||||
|
}
|
||||||
|
in
|
||||||
|
( { model | status = status }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
GotSession session ->
|
||||||
|
( { model | session = session }
|
||||||
|
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||||
|
)
|
||||||
|
|
||||||
|
PassedSlowLoadThreshold ->
|
||||||
|
let
|
||||||
|
-- If any data is still Loading, change it to LoadingSlowly
|
||||||
|
-- so `view` knows to render a spinner.
|
||||||
|
status =
|
||||||
|
case model.status of
|
||||||
|
Loading slug ->
|
||||||
|
LoadingSlowly slug
|
||||||
|
|
||||||
|
other ->
|
||||||
|
other
|
||||||
|
in
|
||||||
|
( { model | status = status }, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
save : Cred -> Status -> ( Status, Cmd Msg )
|
||||||
|
save cred status =
|
||||||
|
case status of
|
||||||
|
Editing slug _ form ->
|
||||||
|
case validate form of
|
||||||
|
Ok validForm ->
|
||||||
|
( Saving slug form
|
||||||
|
, edit slug validForm cred
|
||||||
|
|> Http.send CompletedEdit
|
||||||
|
)
|
||||||
|
|
||||||
|
Err problems ->
|
||||||
|
( Editing slug problems form
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
EditingNew _ form ->
|
||||||
|
case validate form of
|
||||||
|
Ok validForm ->
|
||||||
|
( Creating form
|
||||||
|
, create validForm cred
|
||||||
|
|> Http.send CompletedCreate
|
||||||
|
)
|
||||||
|
|
||||||
|
Err problems ->
|
||||||
|
( EditingNew problems form
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
-- We're in a state where saving is not allowed.
|
||||||
|
-- We tried to prevent getting here by disabling the Save
|
||||||
|
-- button, but somehow the user got here anyway!
|
||||||
|
--
|
||||||
|
-- If we had an error logging service, we would send
|
||||||
|
-- something to it here!
|
||||||
|
( status, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
savingError : Http.Error -> Status -> Status
|
||||||
|
savingError error status =
|
||||||
|
let
|
||||||
|
problems =
|
||||||
|
[ ServerError "Error saving article" ]
|
||||||
|
in
|
||||||
|
case status of
|
||||||
|
Saving slug form ->
|
||||||
|
Editing slug problems form
|
||||||
|
|
||||||
|
Creating form ->
|
||||||
|
EditingNew problems form
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
status
|
||||||
|
|
||||||
|
|
||||||
|
{-| Helper function for `update`. Updates the form, if there is one,
|
||||||
|
and returns Cmd.none.
|
||||||
|
|
||||||
|
Useful for recording form fields!
|
||||||
|
|
||||||
|
This could also log errors to the server if we are trying to record things in
|
||||||
|
the form and we don't actually have a form.
|
||||||
|
|
||||||
|
-}
|
||||||
|
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
||||||
|
updateForm transform model =
|
||||||
|
let
|
||||||
|
newModel =
|
||||||
|
case model.status of
|
||||||
|
Loading _ ->
|
||||||
|
model
|
||||||
|
|
||||||
|
LoadingSlowly _ ->
|
||||||
|
model
|
||||||
|
|
||||||
|
LoadingFailed _ ->
|
||||||
|
model
|
||||||
|
|
||||||
|
Saving slug form ->
|
||||||
|
{ model | status = Saving slug (transform form) }
|
||||||
|
|
||||||
|
Editing slug errors form ->
|
||||||
|
{ model | status = Editing slug errors (transform form) }
|
||||||
|
|
||||||
|
EditingNew errors form ->
|
||||||
|
{ model | status = EditingNew errors (transform form) }
|
||||||
|
|
||||||
|
Creating form ->
|
||||||
|
{ model | status = Creating (transform form) }
|
||||||
|
in
|
||||||
|
( newModel, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SUBSCRIPTIONS
|
||||||
|
|
||||||
|
|
||||||
|
subscriptions : Model -> Sub Msg
|
||||||
|
subscriptions model =
|
||||||
|
Session.changes GotSession (Session.navKey model.session)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FORM
|
||||||
|
|
||||||
|
|
||||||
|
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
||||||
|
it to the server without having trimmed it!
|
||||||
|
-}
|
||||||
|
type TrimmedForm
|
||||||
|
= Trimmed Form
|
||||||
|
|
||||||
|
|
||||||
|
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
||||||
|
-}
|
||||||
|
type ValidatedField
|
||||||
|
= Title
|
||||||
|
| Body
|
||||||
|
|
||||||
|
|
||||||
|
fieldsToValidate : List ValidatedField
|
||||||
|
fieldsToValidate =
|
||||||
|
[ Title
|
||||||
|
, Body
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Trim the form and validate its fields. If there are problems, report them!
|
||||||
|
-}
|
||||||
|
validate : Form -> Result (List Problem) TrimmedForm
|
||||||
|
validate form =
|
||||||
|
let
|
||||||
|
trimmedForm =
|
||||||
|
trimFields form
|
||||||
|
in
|
||||||
|
case List.concatMap (validateField trimmedForm) fieldsToValidate of
|
||||||
|
[] ->
|
||||||
|
Ok trimmedForm
|
||||||
|
|
||||||
|
problems ->
|
||||||
|
Err problems
|
||||||
|
|
||||||
|
|
||||||
|
validateField : TrimmedForm -> ValidatedField -> List Problem
|
||||||
|
validateField (Trimmed form) field =
|
||||||
|
List.map (InvalidEntry field) <|
|
||||||
|
case field of
|
||||||
|
Title ->
|
||||||
|
if String.isEmpty form.title then
|
||||||
|
[ "title can't be blank." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
Body ->
|
||||||
|
if String.isEmpty form.body then
|
||||||
|
[ "body can't be blank." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Don't trim while the user is typing! That would be super annoying.
|
||||||
|
Instead, trim only on submit.
|
||||||
|
-}
|
||||||
|
trimFields : Form -> TrimmedForm
|
||||||
|
trimFields form =
|
||||||
|
Trimmed
|
||||||
|
{ title = String.trim form.title
|
||||||
|
, body = String.trim form.body
|
||||||
|
, description = String.trim form.description
|
||||||
|
, tags = String.trim form.tags
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- HTTP
|
||||||
|
|
||||||
|
|
||||||
|
create : TrimmedForm -> Cred -> Http.Request (Article Full)
|
||||||
|
create (Trimmed form) cred =
|
||||||
|
let
|
||||||
|
expect =
|
||||||
|
Article.fullDecoder (Just cred)
|
||||||
|
|> Decode.field "article"
|
||||||
|
|> Http.expectJson
|
||||||
|
|
||||||
|
article =
|
||||||
|
Encode.object
|
||||||
|
[ ( "title", Encode.string form.title )
|
||||||
|
, ( "description", Encode.string form.description )
|
||||||
|
, ( "body", Encode.string form.body )
|
||||||
|
, ( "tagList", Encode.list Encode.string (tagsFromString form.tags) )
|
||||||
|
]
|
||||||
|
|
||||||
|
jsonBody =
|
||||||
|
Encode.object [ ( "article", article ) ]
|
||||||
|
|> Http.jsonBody
|
||||||
|
in
|
||||||
|
Api.url [ "articles" ]
|
||||||
|
|> HttpBuilder.post
|
||||||
|
|> Cred.addHeader cred
|
||||||
|
|> withBody jsonBody
|
||||||
|
|> withExpect expect
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
tagsFromString : String -> List String
|
||||||
|
tagsFromString str =
|
||||||
|
str
|
||||||
|
|> String.split " "
|
||||||
|
|> List.map String.trim
|
||||||
|
|> List.filter (not << String.isEmpty)
|
||||||
|
|
||||||
|
|
||||||
|
edit : Slug -> TrimmedForm -> Cred -> Http.Request (Article Full)
|
||||||
|
edit articleSlug (Trimmed form) cred =
|
||||||
|
let
|
||||||
|
expect =
|
||||||
|
Article.fullDecoder (Just cred)
|
||||||
|
|> Decode.field "article"
|
||||||
|
|> Http.expectJson
|
||||||
|
|
||||||
|
article =
|
||||||
|
Encode.object
|
||||||
|
[ ( "title", Encode.string form.title )
|
||||||
|
, ( "description", Encode.string form.description )
|
||||||
|
, ( "body", Encode.string form.body )
|
||||||
|
]
|
||||||
|
|
||||||
|
jsonBody =
|
||||||
|
Encode.object [ ( "article", article ) ]
|
||||||
|
|> Http.jsonBody
|
||||||
|
in
|
||||||
|
Article.url articleSlug []
|
||||||
|
|> HttpBuilder.put
|
||||||
|
|> Cred.addHeader cred
|
||||||
|
|> withBody jsonBody
|
||||||
|
|> withExpect expect
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- EXPORT
|
||||||
|
|
||||||
|
|
||||||
|
toSession : Model -> Session
|
||||||
|
toSession model =
|
||||||
|
model.session
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INTERNAL
|
||||||
|
|
||||||
|
|
||||||
|
{-| Used for setting the page's title.
|
||||||
|
-}
|
||||||
|
getSlug : Status -> Maybe Slug
|
||||||
|
getSlug status =
|
||||||
|
case status of
|
||||||
|
Loading slug ->
|
||||||
|
Just slug
|
||||||
|
|
||||||
|
LoadingSlowly slug ->
|
||||||
|
Just slug
|
||||||
|
|
||||||
|
LoadingFailed slug ->
|
||||||
|
Just slug
|
||||||
|
|
||||||
|
Saving slug _ ->
|
||||||
|
Just slug
|
||||||
|
|
||||||
|
Editing slug _ _ ->
|
||||||
|
Just slug
|
||||||
|
|
||||||
|
EditingNew _ _ ->
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
Creating _ ->
|
||||||
|
Nothing
|
||||||
10
intro/part5/src/Page/Blank.elm
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
module Page.Blank exposing (view)
|
||||||
|
|
||||||
|
import Html exposing (Html)
|
||||||
|
|
||||||
|
|
||||||
|
view : { title : String, content : Html msg }
|
||||||
|
view =
|
||||||
|
{ title = ""
|
||||||
|
, content = Html.text ""
|
||||||
|
}
|
||||||
259
intro/part5/src/Page/Home.elm
Normal file
@@ -0,0 +1,259 @@
|
|||||||
|
module Page.Home exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||||
|
|
||||||
|
{-| The homepage. You can get here via either the / or /#/ routes.
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Article
|
||||||
|
import Article.Feed as Feed
|
||||||
|
import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
|
||||||
|
import Article.Tag as Tag exposing (Tag)
|
||||||
|
import Html exposing (..)
|
||||||
|
import Html.Attributes exposing (attribute, class, classList, href, id, placeholder)
|
||||||
|
import Html.Events exposing (onClick)
|
||||||
|
import Http
|
||||||
|
import Loading
|
||||||
|
import Log
|
||||||
|
import Page
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Task exposing (Task)
|
||||||
|
import Time
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- MODEL
|
||||||
|
|
||||||
|
|
||||||
|
type alias Model =
|
||||||
|
{ session : Session
|
||||||
|
, timeZone : Time.Zone
|
||||||
|
|
||||||
|
-- Loaded independently from server
|
||||||
|
, tags : Status (List Tag)
|
||||||
|
, feed : Status Feed.Model
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type Status a
|
||||||
|
= Loading
|
||||||
|
| LoadingSlowly
|
||||||
|
| Loaded a
|
||||||
|
| Failed
|
||||||
|
|
||||||
|
|
||||||
|
init : Session -> ( Model, Cmd Msg )
|
||||||
|
init session =
|
||||||
|
let
|
||||||
|
feedSources =
|
||||||
|
case Session.cred session of
|
||||||
|
Just cred ->
|
||||||
|
FeedSources.fromLists (YourFeed cred) [ GlobalFeed ]
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
FeedSources.fromLists GlobalFeed []
|
||||||
|
|
||||||
|
loadTags =
|
||||||
|
Tag.list
|
||||||
|
|> Http.toTask
|
||||||
|
in
|
||||||
|
( { session = session
|
||||||
|
, timeZone = Time.utc
|
||||||
|
, tags = Loading
|
||||||
|
, feed = Loading
|
||||||
|
}
|
||||||
|
, Cmd.batch
|
||||||
|
[ Feed.init session feedSources
|
||||||
|
|> Task.attempt CompletedFeedLoad
|
||||||
|
, Tag.list
|
||||||
|
|> Http.send CompletedTagsLoad
|
||||||
|
, Task.perform GotTimeZone Time.here
|
||||||
|
, Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : Model -> { title : String, content : Html Msg }
|
||||||
|
view model =
|
||||||
|
{ title = "Conduit"
|
||||||
|
, content =
|
||||||
|
div [ class "home-page" ]
|
||||||
|
[ viewBanner
|
||||||
|
, div [ class "container page" ]
|
||||||
|
[ div [ class "row" ]
|
||||||
|
[ div [ class "col-md-9" ] <|
|
||||||
|
case model.feed of
|
||||||
|
Loaded feed ->
|
||||||
|
viewFeed model.timeZone feed
|
||||||
|
|
||||||
|
Loading ->
|
||||||
|
[]
|
||||||
|
|
||||||
|
LoadingSlowly ->
|
||||||
|
[ Loading.icon ]
|
||||||
|
|
||||||
|
Failed ->
|
||||||
|
[ Loading.error "feed" ]
|
||||||
|
, div [ class "col-md-3" ] <|
|
||||||
|
case model.tags of
|
||||||
|
Loaded tags ->
|
||||||
|
[ div [ class "sidebar" ] <|
|
||||||
|
[ p [] [ text "Popular Tags" ]
|
||||||
|
, viewTags tags
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
Loading ->
|
||||||
|
[]
|
||||||
|
|
||||||
|
LoadingSlowly ->
|
||||||
|
[ Loading.icon ]
|
||||||
|
|
||||||
|
Failed ->
|
||||||
|
[ Loading.error "tags" ]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
viewBanner : Html msg
|
||||||
|
viewBanner =
|
||||||
|
div [ class "banner" ]
|
||||||
|
[ div [ class "container" ]
|
||||||
|
[ h1 [ class "logo-font" ] [ text "conduit" ]
|
||||||
|
, p [] [ text "A place to share your knowledge." ]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewFeed : Time.Zone -> Feed.Model -> List (Html Msg)
|
||||||
|
viewFeed timeZone feed =
|
||||||
|
div [ class "feed-toggle" ]
|
||||||
|
[ Feed.viewFeedSources feed |> Html.map GotFeedMsg ]
|
||||||
|
:: (Feed.viewArticles timeZone feed |> List.map (Html.map GotFeedMsg))
|
||||||
|
|
||||||
|
|
||||||
|
viewTags : List Tag -> Html Msg
|
||||||
|
viewTags tags =
|
||||||
|
div [ class "tag-list" ] (List.map viewTag tags)
|
||||||
|
|
||||||
|
|
||||||
|
viewTag : Tag -> Html Msg
|
||||||
|
viewTag tagName =
|
||||||
|
a
|
||||||
|
[ class "tag-pill tag-default"
|
||||||
|
, onClick (ClickedTag tagName)
|
||||||
|
|
||||||
|
-- The RealWorld CSS requires an href to work properly.
|
||||||
|
, href ""
|
||||||
|
]
|
||||||
|
[ text (Tag.toString tagName) ]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- UPDATE
|
||||||
|
|
||||||
|
|
||||||
|
type Msg
|
||||||
|
= ClickedTag Tag
|
||||||
|
| CompletedFeedLoad (Result Http.Error Feed.Model)
|
||||||
|
| CompletedTagsLoad (Result Http.Error (List Tag))
|
||||||
|
| GotTimeZone Time.Zone
|
||||||
|
| GotFeedMsg Feed.Msg
|
||||||
|
| GotSession Session
|
||||||
|
| PassedSlowLoadThreshold
|
||||||
|
|
||||||
|
|
||||||
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||||
|
update msg model =
|
||||||
|
case msg of
|
||||||
|
ClickedTag tagName ->
|
||||||
|
let
|
||||||
|
subCmd =
|
||||||
|
Feed.selectTag (Session.cred model.session) tagName
|
||||||
|
in
|
||||||
|
( model, Cmd.map GotFeedMsg subCmd )
|
||||||
|
|
||||||
|
CompletedFeedLoad (Ok feed) ->
|
||||||
|
( { model | feed = Loaded feed }, Cmd.none )
|
||||||
|
|
||||||
|
CompletedFeedLoad (Err error) ->
|
||||||
|
( { model | feed = Failed }, Cmd.none )
|
||||||
|
|
||||||
|
CompletedTagsLoad (Ok tags) ->
|
||||||
|
( { model | tags = Loaded tags }, Cmd.none )
|
||||||
|
|
||||||
|
CompletedTagsLoad (Err error) ->
|
||||||
|
( { model | tags = Failed }
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
GotFeedMsg subMsg ->
|
||||||
|
case model.feed of
|
||||||
|
Loaded feed ->
|
||||||
|
let
|
||||||
|
( newFeed, subCmd ) =
|
||||||
|
Feed.update (Session.cred model.session) subMsg feed
|
||||||
|
in
|
||||||
|
( { model | feed = Loaded newFeed }
|
||||||
|
, Cmd.map GotFeedMsg subCmd
|
||||||
|
)
|
||||||
|
|
||||||
|
Loading ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
LoadingSlowly ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
Failed ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
GotTimeZone tz ->
|
||||||
|
( { model | timeZone = tz }, Cmd.none )
|
||||||
|
|
||||||
|
GotSession session ->
|
||||||
|
( { model | session = session }, Cmd.none )
|
||||||
|
|
||||||
|
PassedSlowLoadThreshold ->
|
||||||
|
let
|
||||||
|
-- If any data is still Loading, change it to LoadingSlowly
|
||||||
|
-- so `view` knows to render a spinner.
|
||||||
|
feed =
|
||||||
|
case model.feed of
|
||||||
|
Loading ->
|
||||||
|
LoadingSlowly
|
||||||
|
|
||||||
|
other ->
|
||||||
|
other
|
||||||
|
|
||||||
|
tags =
|
||||||
|
case model.tags of
|
||||||
|
Loading ->
|
||||||
|
LoadingSlowly
|
||||||
|
|
||||||
|
other ->
|
||||||
|
other
|
||||||
|
in
|
||||||
|
( { model | feed = feed, tags = tags }, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SUBSCRIPTIONS
|
||||||
|
|
||||||
|
|
||||||
|
subscriptions : Model -> Sub Msg
|
||||||
|
subscriptions model =
|
||||||
|
Session.changes GotSession (Session.navKey model.session)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- EXPORT
|
||||||
|
|
||||||
|
|
||||||
|
toSession : Model -> Session
|
||||||
|
toSession model =
|
||||||
|
model.session
|
||||||
317
intro/part5/src/Page/Login.elm
Normal file
@@ -0,0 +1,317 @@
|
|||||||
|
module Page.Login exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||||
|
|
||||||
|
{-| The login page.
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Browser.Navigation as Nav
|
||||||
|
import Html exposing (..)
|
||||||
|
import Html.Attributes exposing (..)
|
||||||
|
import Html.Events exposing (..)
|
||||||
|
import Http
|
||||||
|
import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
|
||||||
|
import Json.Decode.Pipeline exposing (optional)
|
||||||
|
import Json.Encode as Encode
|
||||||
|
import Route exposing (Route)
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- MODEL
|
||||||
|
|
||||||
|
|
||||||
|
type alias Model =
|
||||||
|
{ session : Session
|
||||||
|
, problems : List Problem
|
||||||
|
, form : Form
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Recording validation problems on a per-field basis facilitates displaying
|
||||||
|
them inline next to the field where the error occurred.
|
||||||
|
|
||||||
|
I implemented it this way out of habit, then realized the spec called for
|
||||||
|
displaying all the errors at the top. I thought about simplifying it, but then
|
||||||
|
figured it'd be useful to show how I would normally model this data - assuming
|
||||||
|
the intended UX was to render errors per field.
|
||||||
|
|
||||||
|
(The other part of this is having a view function like this:
|
||||||
|
|
||||||
|
viewFieldErrors : ValidatedField -> List Problem -> Html msg
|
||||||
|
|
||||||
|
...and it filters the list of problems to render only InvalidEntry ones for the
|
||||||
|
given ValidatedField. That way you can call this:
|
||||||
|
|
||||||
|
viewFieldErrors Email problems
|
||||||
|
|
||||||
|
...next to the `email` field, and call `viewFieldErrors Password problems`
|
||||||
|
next to the `password` field, and so on.
|
||||||
|
|
||||||
|
The `LoginError` should be displayed elsewhere, since it doesn't correspond to
|
||||||
|
a particular field.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type Problem
|
||||||
|
= InvalidEntry ValidatedField String
|
||||||
|
| ServerError String
|
||||||
|
|
||||||
|
|
||||||
|
type alias Form =
|
||||||
|
{ email : String
|
||||||
|
, password : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
init : Session -> ( Model, Cmd msg )
|
||||||
|
init session =
|
||||||
|
( { session = session
|
||||||
|
, problems = []
|
||||||
|
, form =
|
||||||
|
{ email = ""
|
||||||
|
, password = ""
|
||||||
|
}
|
||||||
|
}
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : Model -> { title : String, content : Html Msg }
|
||||||
|
view model =
|
||||||
|
{ title = "Login"
|
||||||
|
, content =
|
||||||
|
div [ class "cred-page" ]
|
||||||
|
[ div [ class "container page" ]
|
||||||
|
[ div [ class "row" ]
|
||||||
|
[ div [ class "col-md-6 offset-md-3 col-xs-12" ]
|
||||||
|
[ h1 [ class "text-xs-center" ] [ text "Sign in" ]
|
||||||
|
, p [ class "text-xs-center" ]
|
||||||
|
[ a [ Route.href Route.Register ]
|
||||||
|
[ text "Need an account?" ]
|
||||||
|
]
|
||||||
|
, ul [ class "error-messages" ]
|
||||||
|
(List.map viewProblem model.problems)
|
||||||
|
, viewForm model.form
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
viewProblem : Problem -> Html msg
|
||||||
|
viewProblem problem =
|
||||||
|
let
|
||||||
|
errorMessage =
|
||||||
|
case problem of
|
||||||
|
InvalidEntry _ str ->
|
||||||
|
str
|
||||||
|
|
||||||
|
ServerError str ->
|
||||||
|
str
|
||||||
|
in
|
||||||
|
li [] [ text errorMessage ]
|
||||||
|
|
||||||
|
|
||||||
|
viewForm : Form -> Html Msg
|
||||||
|
viewForm form =
|
||||||
|
Html.form [ onSubmit SubmittedForm ]
|
||||||
|
[ fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, placeholder "Email"
|
||||||
|
, onInput EnteredEmail
|
||||||
|
, value form.email
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, type_ "password"
|
||||||
|
, placeholder "Password"
|
||||||
|
, onInput EnteredPassword
|
||||||
|
, value form.password
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, button [ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||||
|
[ text "Sign in" ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- UPDATE
|
||||||
|
|
||||||
|
|
||||||
|
type Msg
|
||||||
|
= SubmittedForm
|
||||||
|
| EnteredEmail String
|
||||||
|
| EnteredPassword String
|
||||||
|
| CompletedLogin (Result Http.Error Viewer)
|
||||||
|
| GotSession Session
|
||||||
|
|
||||||
|
|
||||||
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||||
|
update msg model =
|
||||||
|
case msg of
|
||||||
|
SubmittedForm ->
|
||||||
|
case validate model.form of
|
||||||
|
Ok validForm ->
|
||||||
|
( { model | problems = [] }
|
||||||
|
, Http.send CompletedLogin (login validForm)
|
||||||
|
)
|
||||||
|
|
||||||
|
Err problems ->
|
||||||
|
( { model | problems = problems }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
EnteredEmail email ->
|
||||||
|
updateForm (\form -> { form | email = email }) model
|
||||||
|
|
||||||
|
EnteredPassword password ->
|
||||||
|
updateForm (\form -> { form | password = password }) model
|
||||||
|
|
||||||
|
CompletedLogin (Err error) ->
|
||||||
|
let
|
||||||
|
serverErrors =
|
||||||
|
Api.decodeErrors error
|
||||||
|
|> List.map ServerError
|
||||||
|
in
|
||||||
|
( { model | problems = List.append model.problems serverErrors }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedLogin (Ok viewer) ->
|
||||||
|
( model
|
||||||
|
, Session.login viewer
|
||||||
|
)
|
||||||
|
|
||||||
|
GotSession session ->
|
||||||
|
( { model | session = session }
|
||||||
|
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Helper function for `update`. Updates the form and returns Cmd.none and
|
||||||
|
Ignored. Useful for recording form fields!
|
||||||
|
-}
|
||||||
|
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
||||||
|
updateForm transform model =
|
||||||
|
( { model | form = transform model.form }, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SUBSCRIPTIONS
|
||||||
|
|
||||||
|
|
||||||
|
subscriptions : Model -> Sub Msg
|
||||||
|
subscriptions model =
|
||||||
|
Session.changes GotSession (Session.navKey model.session)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FORM
|
||||||
|
|
||||||
|
|
||||||
|
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
||||||
|
it to the server without having trimmed it!
|
||||||
|
-}
|
||||||
|
type TrimmedForm
|
||||||
|
= Trimmed Form
|
||||||
|
|
||||||
|
|
||||||
|
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
||||||
|
-}
|
||||||
|
type ValidatedField
|
||||||
|
= Email
|
||||||
|
| Password
|
||||||
|
|
||||||
|
|
||||||
|
fieldsToValidate : List ValidatedField
|
||||||
|
fieldsToValidate =
|
||||||
|
[ Email
|
||||||
|
, Password
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Trim the form and validate its fields. If there are problems, report them!
|
||||||
|
-}
|
||||||
|
validate : Form -> Result (List Problem) TrimmedForm
|
||||||
|
validate form =
|
||||||
|
let
|
||||||
|
trimmedForm =
|
||||||
|
trimFields form
|
||||||
|
in
|
||||||
|
case List.concatMap (validateField trimmedForm) fieldsToValidate of
|
||||||
|
[] ->
|
||||||
|
Ok trimmedForm
|
||||||
|
|
||||||
|
problems ->
|
||||||
|
Err problems
|
||||||
|
|
||||||
|
|
||||||
|
validateField : TrimmedForm -> ValidatedField -> List Problem
|
||||||
|
validateField (Trimmed form) field =
|
||||||
|
List.map (InvalidEntry field) <|
|
||||||
|
case field of
|
||||||
|
Email ->
|
||||||
|
if String.isEmpty form.email then
|
||||||
|
[ "email can't be blank." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
Password ->
|
||||||
|
if String.isEmpty form.password then
|
||||||
|
[ "password can't be blank." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Don't trim while the user is typing! That would be super annoying.
|
||||||
|
Instead, trim only on submit.
|
||||||
|
-}
|
||||||
|
trimFields : Form -> TrimmedForm
|
||||||
|
trimFields form =
|
||||||
|
Trimmed
|
||||||
|
{ email = String.trim form.email
|
||||||
|
, password = String.trim form.password
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- HTTP
|
||||||
|
|
||||||
|
|
||||||
|
login : TrimmedForm -> Http.Request Viewer
|
||||||
|
login (Trimmed form) =
|
||||||
|
let
|
||||||
|
user =
|
||||||
|
Encode.object
|
||||||
|
[ ( "email", Encode.string form.email )
|
||||||
|
, ( "password", Encode.string form.password )
|
||||||
|
]
|
||||||
|
|
||||||
|
body =
|
||||||
|
Encode.object [ ( "user", user ) ]
|
||||||
|
|> Http.jsonBody
|
||||||
|
in
|
||||||
|
Decode.field "user" Viewer.decoder
|
||||||
|
|> Http.post (Api.url [ "users", "login" ]) body
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- EXPORT
|
||||||
|
|
||||||
|
|
||||||
|
toSession : Model -> Session
|
||||||
|
toSession model =
|
||||||
|
model.session
|
||||||
21
intro/part5/src/Page/NotFound.elm
Normal file
@@ -0,0 +1,21 @@
|
|||||||
|
module Page.NotFound exposing (view)
|
||||||
|
|
||||||
|
import Asset
|
||||||
|
import Html exposing (Html, div, h1, img, main_, text)
|
||||||
|
import Html.Attributes exposing (alt, class, id, src, tabindex)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : { title : String, content : Html msg }
|
||||||
|
view =
|
||||||
|
{ title = "Page Not Found"
|
||||||
|
, content =
|
||||||
|
main_ [ id "content", class "container", tabindex -1 ]
|
||||||
|
[ h1 [] [ text "Not Found" ]
|
||||||
|
, div [ class "row" ]
|
||||||
|
[ img [ Asset.src Asset.error ] [] ]
|
||||||
|
]
|
||||||
|
}
|
||||||
346
intro/part5/src/Page/Profile.elm
Normal file
@@ -0,0 +1,346 @@
|
|||||||
|
module Page.Profile exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||||
|
|
||||||
|
{-| An Author's profile.
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Article.Feed as Feed
|
||||||
|
import Article.FeedSources as FeedSources exposing (FeedSources, Source(..))
|
||||||
|
import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor)
|
||||||
|
import Avatar exposing (Avatar)
|
||||||
|
import Html exposing (..)
|
||||||
|
import Html.Attributes exposing (..)
|
||||||
|
import Http
|
||||||
|
import Loading
|
||||||
|
import Log
|
||||||
|
import Page
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Route
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Task exposing (Task)
|
||||||
|
import Time
|
||||||
|
import Username exposing (Username)
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- MODEL
|
||||||
|
|
||||||
|
|
||||||
|
type alias Model =
|
||||||
|
{ session : Session
|
||||||
|
, timeZone : Time.Zone
|
||||||
|
, errors : List String
|
||||||
|
|
||||||
|
-- Loaded independently from server
|
||||||
|
, author : Status Author
|
||||||
|
, feed : Status Feed.Model
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type Status a
|
||||||
|
= Loading Username
|
||||||
|
| LoadingSlowly Username
|
||||||
|
| Loaded a
|
||||||
|
| Failed Username
|
||||||
|
|
||||||
|
|
||||||
|
init : Session -> Username -> ( Model, Cmd Msg )
|
||||||
|
init session username =
|
||||||
|
let
|
||||||
|
maybeCred =
|
||||||
|
Session.cred session
|
||||||
|
in
|
||||||
|
( { session = session
|
||||||
|
, timeZone = Time.utc
|
||||||
|
, errors = []
|
||||||
|
, author = Loading username
|
||||||
|
, feed = Loading username
|
||||||
|
}
|
||||||
|
, Cmd.batch
|
||||||
|
[ Author.fetch username maybeCred
|
||||||
|
|> Http.toTask
|
||||||
|
|> Task.mapError (Tuple.pair username)
|
||||||
|
|> Task.attempt CompletedAuthorLoad
|
||||||
|
, defaultFeedSources username
|
||||||
|
|> Feed.init session
|
||||||
|
|> Task.mapError (Tuple.pair username)
|
||||||
|
|> Task.attempt CompletedFeedLoad
|
||||||
|
, Task.perform GotTimeZone Time.here
|
||||||
|
, Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : Model -> { title : String, content : Html Msg }
|
||||||
|
view model =
|
||||||
|
let
|
||||||
|
title =
|
||||||
|
case model.author of
|
||||||
|
Loaded (IsViewer _ _) ->
|
||||||
|
myProfileTitle
|
||||||
|
|
||||||
|
Loaded ((IsFollowing followedAuthor) as author) ->
|
||||||
|
titleForOther (Author.username author)
|
||||||
|
|
||||||
|
Loaded ((IsNotFollowing unfollowedAuthor) as author) ->
|
||||||
|
titleForOther (Author.username author)
|
||||||
|
|
||||||
|
Loading username ->
|
||||||
|
titleForMe (Session.cred model.session) username
|
||||||
|
|
||||||
|
LoadingSlowly username ->
|
||||||
|
titleForMe (Session.cred model.session) username
|
||||||
|
|
||||||
|
Failed username ->
|
||||||
|
titleForMe (Session.cred model.session) username
|
||||||
|
in
|
||||||
|
{ title = title
|
||||||
|
, content =
|
||||||
|
case model.author of
|
||||||
|
Loaded author ->
|
||||||
|
let
|
||||||
|
profile =
|
||||||
|
Author.profile author
|
||||||
|
|
||||||
|
username =
|
||||||
|
Author.username author
|
||||||
|
|
||||||
|
followButton =
|
||||||
|
case Session.cred model.session of
|
||||||
|
Just cred ->
|
||||||
|
case author of
|
||||||
|
IsViewer _ _ ->
|
||||||
|
-- We can't follow ourselves!
|
||||||
|
text ""
|
||||||
|
|
||||||
|
IsFollowing followedAuthor ->
|
||||||
|
Author.unfollowButton ClickedUnfollow cred followedAuthor
|
||||||
|
|
||||||
|
IsNotFollowing unfollowedAuthor ->
|
||||||
|
Author.followButton ClickedFollow cred unfollowedAuthor
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
-- We can't follow if we're logged out
|
||||||
|
text ""
|
||||||
|
in
|
||||||
|
div [ class "profile-page" ]
|
||||||
|
[ Page.viewErrors ClickedDismissErrors model.errors
|
||||||
|
, div [ class "user-info" ]
|
||||||
|
[ div [ class "container" ]
|
||||||
|
[ div [ class "row" ]
|
||||||
|
[ div [ class "col-xs-12 col-md-10 offset-md-1" ]
|
||||||
|
[ img [ class "user-img", Avatar.src (Profile.avatar profile) ] []
|
||||||
|
, h4 [] [ Username.toHtml username ]
|
||||||
|
, p [] [ text (Maybe.withDefault "" (Profile.bio profile)) ]
|
||||||
|
, followButton
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
, case model.feed of
|
||||||
|
Loaded feed ->
|
||||||
|
div [ class "container" ]
|
||||||
|
[ div [ class "row" ] [ viewFeed model.timeZone feed ] ]
|
||||||
|
|
||||||
|
Loading _ ->
|
||||||
|
text ""
|
||||||
|
|
||||||
|
LoadingSlowly _ ->
|
||||||
|
Loading.icon
|
||||||
|
|
||||||
|
Failed _ ->
|
||||||
|
Loading.error "feed"
|
||||||
|
]
|
||||||
|
|
||||||
|
Loading _ ->
|
||||||
|
text ""
|
||||||
|
|
||||||
|
LoadingSlowly _ ->
|
||||||
|
Loading.icon
|
||||||
|
|
||||||
|
Failed _ ->
|
||||||
|
Loading.error "profile"
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- PAGE TITLE
|
||||||
|
|
||||||
|
|
||||||
|
titleForOther : Username -> String
|
||||||
|
titleForOther otherUsername =
|
||||||
|
"Profile — " ++ Username.toString otherUsername
|
||||||
|
|
||||||
|
|
||||||
|
titleForMe : Maybe Cred -> Username -> String
|
||||||
|
titleForMe maybeCred username =
|
||||||
|
case maybeCred of
|
||||||
|
Just cred ->
|
||||||
|
if username == Cred.username cred then
|
||||||
|
myProfileTitle
|
||||||
|
|
||||||
|
else
|
||||||
|
defaultTitle
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
defaultTitle
|
||||||
|
|
||||||
|
|
||||||
|
myProfileTitle : String
|
||||||
|
myProfileTitle =
|
||||||
|
"My Profile"
|
||||||
|
|
||||||
|
|
||||||
|
defaultTitle : String
|
||||||
|
defaultTitle =
|
||||||
|
"Profile"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FEED
|
||||||
|
|
||||||
|
|
||||||
|
viewFeed : Time.Zone -> Feed.Model -> Html Msg
|
||||||
|
viewFeed timeZone feed =
|
||||||
|
div [ class "col-xs-12 col-md-10 offset-md-1" ] <|
|
||||||
|
div [ class "articles-toggle" ]
|
||||||
|
[ Feed.viewFeedSources feed |> Html.map GotFeedMsg ]
|
||||||
|
:: (Feed.viewArticles timeZone feed |> List.map (Html.map GotFeedMsg))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- UPDATE
|
||||||
|
|
||||||
|
|
||||||
|
type Msg
|
||||||
|
= ClickedDismissErrors
|
||||||
|
| ClickedFollow Cred UnfollowedAuthor
|
||||||
|
| ClickedUnfollow Cred FollowedAuthor
|
||||||
|
| CompletedFollowChange (Result Http.Error Author)
|
||||||
|
| CompletedAuthorLoad (Result ( Username, Http.Error ) Author)
|
||||||
|
| CompletedFeedLoad (Result ( Username, Http.Error ) Feed.Model)
|
||||||
|
| GotTimeZone Time.Zone
|
||||||
|
| GotFeedMsg Feed.Msg
|
||||||
|
| GotSession Session
|
||||||
|
| PassedSlowLoadThreshold
|
||||||
|
|
||||||
|
|
||||||
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||||
|
update msg model =
|
||||||
|
case msg of
|
||||||
|
ClickedDismissErrors ->
|
||||||
|
( { model | errors = [] }, Cmd.none )
|
||||||
|
|
||||||
|
ClickedUnfollow cred followedAuthor ->
|
||||||
|
( model
|
||||||
|
, Author.requestUnfollow followedAuthor cred
|
||||||
|
|> Http.send CompletedFollowChange
|
||||||
|
)
|
||||||
|
|
||||||
|
ClickedFollow cred unfollowedAuthor ->
|
||||||
|
( model
|
||||||
|
, Author.requestFollow unfollowedAuthor cred
|
||||||
|
|> Http.send CompletedFollowChange
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedFollowChange (Ok newAuthor) ->
|
||||||
|
( { model | author = Loaded newAuthor }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedFollowChange (Err error) ->
|
||||||
|
( model
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedAuthorLoad (Ok author) ->
|
||||||
|
( { model | author = Loaded author }, Cmd.none )
|
||||||
|
|
||||||
|
CompletedAuthorLoad (Err ( username, err )) ->
|
||||||
|
( { model | author = Failed username }
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedFeedLoad (Ok feed) ->
|
||||||
|
( { model | feed = Loaded feed }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedFeedLoad (Err ( username, err )) ->
|
||||||
|
( { model | feed = Failed username }
|
||||||
|
, Log.error
|
||||||
|
)
|
||||||
|
|
||||||
|
GotFeedMsg subMsg ->
|
||||||
|
case model.feed of
|
||||||
|
Loaded feed ->
|
||||||
|
let
|
||||||
|
( newFeed, subCmd ) =
|
||||||
|
Feed.update (Session.cred model.session) subMsg feed
|
||||||
|
in
|
||||||
|
( { model | feed = Loaded newFeed }
|
||||||
|
, Cmd.map GotFeedMsg subCmd
|
||||||
|
)
|
||||||
|
|
||||||
|
Loading _ ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
LoadingSlowly _ ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
Failed _ ->
|
||||||
|
( model, Log.error )
|
||||||
|
|
||||||
|
GotTimeZone tz ->
|
||||||
|
( { model | timeZone = tz }, Cmd.none )
|
||||||
|
|
||||||
|
GotSession session ->
|
||||||
|
( { model | session = session }
|
||||||
|
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||||
|
)
|
||||||
|
|
||||||
|
PassedSlowLoadThreshold ->
|
||||||
|
let
|
||||||
|
-- If any data is still Loading, change it to LoadingSlowly
|
||||||
|
-- so `view` knows to render a spinner.
|
||||||
|
feed =
|
||||||
|
case model.feed of
|
||||||
|
Loading username ->
|
||||||
|
LoadingSlowly username
|
||||||
|
|
||||||
|
other ->
|
||||||
|
other
|
||||||
|
in
|
||||||
|
( { model | feed = feed }, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SUBSCRIPTIONS
|
||||||
|
|
||||||
|
|
||||||
|
subscriptions : Model -> Sub Msg
|
||||||
|
subscriptions model =
|
||||||
|
Session.changes GotSession (Session.navKey model.session)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- EXPORT
|
||||||
|
|
||||||
|
|
||||||
|
toSession : Model -> Session
|
||||||
|
toSession model =
|
||||||
|
model.session
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INTERNAL
|
||||||
|
|
||||||
|
|
||||||
|
defaultFeedSources : Username -> FeedSources
|
||||||
|
defaultFeedSources username =
|
||||||
|
FeedSources.fromLists (AuthorFeed username) [ FavoritedFeed username ]
|
||||||
319
intro/part5/src/Page/Register.elm
Normal file
@@ -0,0 +1,319 @@
|
|||||||
|
module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Browser.Navigation as Nav
|
||||||
|
import Html exposing (..)
|
||||||
|
import Html.Attributes exposing (..)
|
||||||
|
import Html.Events exposing (..)
|
||||||
|
import Http
|
||||||
|
import Json.Decode as Decode exposing (Decoder, decodeString, field, string)
|
||||||
|
import Json.Decode.Pipeline exposing (optional)
|
||||||
|
import Json.Encode as Encode
|
||||||
|
import Route exposing (Route)
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- MODEL
|
||||||
|
|
||||||
|
|
||||||
|
type alias Model =
|
||||||
|
{ session : Session
|
||||||
|
, problems : List Problem
|
||||||
|
, form : Form
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Form =
|
||||||
|
{ email : String
|
||||||
|
, username : String
|
||||||
|
, password : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type Problem
|
||||||
|
= InvalidEntry ValidatedField String
|
||||||
|
| ServerError String
|
||||||
|
|
||||||
|
|
||||||
|
init : Session -> ( Model, Cmd msg )
|
||||||
|
init session =
|
||||||
|
( { session = session
|
||||||
|
, problems = []
|
||||||
|
, form =
|
||||||
|
{ email = ""
|
||||||
|
, username = ""
|
||||||
|
, password = ""
|
||||||
|
}
|
||||||
|
}
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : Model -> { title : String, content : Html Msg }
|
||||||
|
view model =
|
||||||
|
{ title = "Register"
|
||||||
|
, content =
|
||||||
|
div [ class "cred-page" ]
|
||||||
|
[ div [ class "container page" ]
|
||||||
|
[ div [ class "row" ]
|
||||||
|
[ div [ class "col-md-6 offset-md-3 col-xs-12" ]
|
||||||
|
[ h1 [ class "text-xs-center" ] [ text "Sign up" ]
|
||||||
|
, p [ class "text-xs-center" ]
|
||||||
|
[ a [ Route.href Route.Login ]
|
||||||
|
[ text "Have an account?" ]
|
||||||
|
]
|
||||||
|
, ul [ class "error-messages" ]
|
||||||
|
(List.map viewProblem model.problems)
|
||||||
|
, viewForm model.form
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
viewForm : Form -> Html Msg
|
||||||
|
viewForm form =
|
||||||
|
Html.form [ onSubmit SubmittedForm ]
|
||||||
|
[ fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, placeholder "Username"
|
||||||
|
|
||||||
|
{- 👉 TODO: when the user inputs a username, update it in the Model.
|
||||||
|
|
||||||
|
💡 HINT: Look at how the Email input below does this. 👇
|
||||||
|
-}
|
||||||
|
, value form.username
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, placeholder "Email"
|
||||||
|
, onInput EnteredEmail
|
||||||
|
, value form.email
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, type_ "password"
|
||||||
|
, placeholder "Password"
|
||||||
|
, onInput EnteredPassword
|
||||||
|
, value form.password
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, button [ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||||
|
[ text "Sign up" ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewProblem : Problem -> Html msg
|
||||||
|
viewProblem problem =
|
||||||
|
let
|
||||||
|
errorMessage =
|
||||||
|
case problem of
|
||||||
|
InvalidEntry _ str ->
|
||||||
|
str
|
||||||
|
|
||||||
|
ServerError str ->
|
||||||
|
str
|
||||||
|
in
|
||||||
|
li [] [ text errorMessage ]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- UPDATE
|
||||||
|
|
||||||
|
|
||||||
|
type Msg
|
||||||
|
= SubmittedForm
|
||||||
|
| EnteredEmail String
|
||||||
|
| EnteredPassword String
|
||||||
|
| CompletedRegister (Result Http.Error Viewer)
|
||||||
|
| GotSession Session
|
||||||
|
|
||||||
|
|
||||||
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||||
|
update msg model =
|
||||||
|
case msg of
|
||||||
|
EnteredEmail email ->
|
||||||
|
updateForm (\form -> { form | email = email }) model
|
||||||
|
|
||||||
|
EnteredPassword password ->
|
||||||
|
updateForm (\form -> { form | password = password }) model
|
||||||
|
|
||||||
|
SubmittedForm ->
|
||||||
|
case validate model.form of
|
||||||
|
Ok validForm ->
|
||||||
|
( { model | problems = [] }
|
||||||
|
, Http.send CompletedRegister (register validForm)
|
||||||
|
)
|
||||||
|
|
||||||
|
Err problems ->
|
||||||
|
( { model | problems = problems }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedRegister (Err error) ->
|
||||||
|
let
|
||||||
|
serverErrors =
|
||||||
|
Api.decodeErrors error
|
||||||
|
|> List.map ServerError
|
||||||
|
in
|
||||||
|
( { model | problems = List.append model.problems serverErrors }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedRegister (Ok viewer) ->
|
||||||
|
( model
|
||||||
|
, Session.login viewer
|
||||||
|
)
|
||||||
|
|
||||||
|
GotSession session ->
|
||||||
|
( { model | session = session }
|
||||||
|
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Helper function for `update`. Updates the form and returns Cmd.none and
|
||||||
|
Ignored. Useful for recording form fields!
|
||||||
|
-}
|
||||||
|
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
||||||
|
updateForm transform model =
|
||||||
|
( { model | form = transform model.form }, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SUBSCRIPTIONS
|
||||||
|
|
||||||
|
|
||||||
|
subscriptions : Model -> Sub Msg
|
||||||
|
subscriptions model =
|
||||||
|
Session.changes GotSession (Session.navKey model.session)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- EXPORT
|
||||||
|
|
||||||
|
|
||||||
|
toSession : Model -> Session
|
||||||
|
toSession model =
|
||||||
|
model.session
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FORM
|
||||||
|
|
||||||
|
|
||||||
|
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
||||||
|
it to the server without having trimmed it!
|
||||||
|
-}
|
||||||
|
type TrimmedForm
|
||||||
|
= Trimmed Form
|
||||||
|
|
||||||
|
|
||||||
|
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
||||||
|
-}
|
||||||
|
type ValidatedField
|
||||||
|
= Username
|
||||||
|
| Email
|
||||||
|
| Password
|
||||||
|
|
||||||
|
|
||||||
|
fieldsToValidate : List ValidatedField
|
||||||
|
fieldsToValidate =
|
||||||
|
[ Username
|
||||||
|
, Email
|
||||||
|
, Password
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Trim the form and validate its fields. If there are problems, report them!
|
||||||
|
-}
|
||||||
|
validate : Form -> Result (List Problem) TrimmedForm
|
||||||
|
validate form =
|
||||||
|
let
|
||||||
|
trimmedForm =
|
||||||
|
trimFields form
|
||||||
|
in
|
||||||
|
case List.concatMap (validateField trimmedForm) fieldsToValidate of
|
||||||
|
[] ->
|
||||||
|
Ok trimmedForm
|
||||||
|
|
||||||
|
problems ->
|
||||||
|
Err problems
|
||||||
|
|
||||||
|
|
||||||
|
validateField : TrimmedForm -> ValidatedField -> List Problem
|
||||||
|
validateField (Trimmed form) field =
|
||||||
|
List.map (InvalidEntry field) <|
|
||||||
|
case field of
|
||||||
|
Username ->
|
||||||
|
if String.isEmpty form.username then
|
||||||
|
[ "username can't be blank." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
Email ->
|
||||||
|
if String.isEmpty form.email then
|
||||||
|
[ "email can't be blank." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
Password ->
|
||||||
|
if String.isEmpty form.password then
|
||||||
|
[ "password can't be blank." ]
|
||||||
|
|
||||||
|
else if String.length form.password < Viewer.minPasswordChars then
|
||||||
|
[ "password must be at least " ++ String.fromInt Viewer.minPasswordChars ++ " characters long." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Don't trim while the user is typing! That would be super annoying.
|
||||||
|
Instead, trim only on submit.
|
||||||
|
-}
|
||||||
|
trimFields : Form -> TrimmedForm
|
||||||
|
trimFields form =
|
||||||
|
Trimmed
|
||||||
|
{ username = String.trim form.username
|
||||||
|
, email = String.trim form.email
|
||||||
|
, password = String.trim form.password
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- HTTP
|
||||||
|
|
||||||
|
|
||||||
|
register : TrimmedForm -> Http.Request Viewer
|
||||||
|
register (Trimmed form) =
|
||||||
|
let
|
||||||
|
user =
|
||||||
|
Encode.object
|
||||||
|
[ ( "username", Encode.string form.username )
|
||||||
|
, ( "email", Encode.string form.email )
|
||||||
|
, ( "password", Encode.string form.password )
|
||||||
|
]
|
||||||
|
|
||||||
|
body =
|
||||||
|
Encode.object [ ( "user", user ) ]
|
||||||
|
|> Http.jsonBody
|
||||||
|
in
|
||||||
|
Decode.field "user" Viewer.decoder
|
||||||
|
|> Http.post (Api.url [ "users" ]) body
|
||||||
434
intro/part5/src/Page/Settings.elm
Normal file
@@ -0,0 +1,434 @@
|
|||||||
|
module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view)
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Avatar
|
||||||
|
import Browser.Navigation as Nav
|
||||||
|
import Email exposing (Email)
|
||||||
|
import Html exposing (Html, button, div, fieldset, h1, input, li, text, textarea, ul)
|
||||||
|
import Html.Attributes exposing (attribute, class, placeholder, type_, value)
|
||||||
|
import Html.Events exposing (onInput, onSubmit)
|
||||||
|
import Http
|
||||||
|
import HttpBuilder
|
||||||
|
import Json.Decode as Decode exposing (Decoder, decodeString, field, list, string)
|
||||||
|
import Json.Decode.Pipeline exposing (optional)
|
||||||
|
import Json.Encode as Encode
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Route
|
||||||
|
import Session exposing (Session)
|
||||||
|
import Username as Username exposing (Username)
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- MODEL
|
||||||
|
|
||||||
|
|
||||||
|
type alias Model =
|
||||||
|
{ session : Session
|
||||||
|
, problems : List Problem
|
||||||
|
, form : Form
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Form =
|
||||||
|
{ avatar : String
|
||||||
|
, bio : String
|
||||||
|
, email : String
|
||||||
|
, username : String
|
||||||
|
, password : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type Problem
|
||||||
|
= InvalidEntry ValidatedField String
|
||||||
|
| ServerError String
|
||||||
|
|
||||||
|
|
||||||
|
init : Session -> ( Model, Cmd msg )
|
||||||
|
init session =
|
||||||
|
( { session = session
|
||||||
|
, problems = []
|
||||||
|
, form =
|
||||||
|
case Session.viewer session of
|
||||||
|
Just viewer ->
|
||||||
|
let
|
||||||
|
profile =
|
||||||
|
Viewer.profile viewer
|
||||||
|
|
||||||
|
cred =
|
||||||
|
Viewer.cred viewer
|
||||||
|
in
|
||||||
|
{ avatar = Maybe.withDefault "" (Avatar.toMaybeString (Profile.avatar profile))
|
||||||
|
, email = Email.toString (Viewer.email viewer)
|
||||||
|
, bio = Maybe.withDefault "" (Profile.bio profile)
|
||||||
|
, username = Username.toString (Cred.username cred)
|
||||||
|
, password = ""
|
||||||
|
}
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
-- It's fine to store a blank form here. You won't be
|
||||||
|
-- able to submit it if you're not logged in anyway.
|
||||||
|
{ avatar = ""
|
||||||
|
, email = ""
|
||||||
|
, bio = ""
|
||||||
|
, username = ""
|
||||||
|
, password = ""
|
||||||
|
}
|
||||||
|
}
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| A form that has been validated. Only the `edit` function uses this. Its
|
||||||
|
purpose is to prevent us from forgetting to validate the form before passing
|
||||||
|
it to `edit`.
|
||||||
|
|
||||||
|
This doesn't create any guarantees that the form was actually validated. If
|
||||||
|
we wanted to do that, we'd need to move the form data into a separate module!
|
||||||
|
|
||||||
|
-}
|
||||||
|
type ValidForm
|
||||||
|
= Valid Form
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : Model -> { title : String, content : Html Msg }
|
||||||
|
view model =
|
||||||
|
{ title = "Settings"
|
||||||
|
, content =
|
||||||
|
case Session.cred model.session of
|
||||||
|
Just cred ->
|
||||||
|
div [ class "settings-page" ]
|
||||||
|
[ div [ class "container page" ]
|
||||||
|
[ div [ class "row" ]
|
||||||
|
[ div [ class "col-md-6 offset-md-3 col-xs-12" ]
|
||||||
|
[ h1 [ class "text-xs-center" ] [ text "Your Settings" ]
|
||||||
|
, ul [ class "error-messages" ]
|
||||||
|
(List.map viewProblem model.problems)
|
||||||
|
, viewForm cred model.form
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
text "Sign in to view your settings."
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
viewForm : Cred -> Form -> Html Msg
|
||||||
|
viewForm cred form =
|
||||||
|
Html.form [ onSubmit (SubmittedForm cred) ]
|
||||||
|
[ fieldset []
|
||||||
|
[ fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control"
|
||||||
|
, placeholder "URL of profile picture"
|
||||||
|
, value form.avatar
|
||||||
|
, onInput EnteredAvatar
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, placeholder "Username"
|
||||||
|
, value form.username
|
||||||
|
, onInput EnteredUsername
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ textarea
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, placeholder "Short bio about you"
|
||||||
|
, attribute "rows" "8"
|
||||||
|
, value form.bio
|
||||||
|
, onInput EnteredBio
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, placeholder "Email"
|
||||||
|
, value form.email
|
||||||
|
, onInput EnteredEmail
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, fieldset [ class "form-group" ]
|
||||||
|
[ input
|
||||||
|
[ class "form-control form-control-lg"
|
||||||
|
, type_ "password"
|
||||||
|
, placeholder "Password"
|
||||||
|
, value form.password
|
||||||
|
, onInput EnteredPassword
|
||||||
|
]
|
||||||
|
[]
|
||||||
|
]
|
||||||
|
, button
|
||||||
|
[ class "btn btn-lg btn-primary pull-xs-right" ]
|
||||||
|
[ text "Update Settings" ]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
viewProblem : Problem -> Html msg
|
||||||
|
viewProblem problem =
|
||||||
|
let
|
||||||
|
errorMessage =
|
||||||
|
case problem of
|
||||||
|
InvalidEntry _ message ->
|
||||||
|
message
|
||||||
|
|
||||||
|
ServerError message ->
|
||||||
|
message
|
||||||
|
in
|
||||||
|
li [] [ text errorMessage ]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- UPDATE
|
||||||
|
|
||||||
|
|
||||||
|
type Msg
|
||||||
|
= SubmittedForm Cred
|
||||||
|
| EnteredEmail String
|
||||||
|
| EnteredUsername String
|
||||||
|
| EnteredPassword String
|
||||||
|
| EnteredBio String
|
||||||
|
| EnteredAvatar String
|
||||||
|
| CompletedSave (Result Http.Error Viewer)
|
||||||
|
| GotSession Session
|
||||||
|
|
||||||
|
|
||||||
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||||
|
update msg model =
|
||||||
|
case msg of
|
||||||
|
SubmittedForm cred ->
|
||||||
|
case validate model.form of
|
||||||
|
Ok validForm ->
|
||||||
|
( { model | problems = [] }
|
||||||
|
, edit cred validForm
|
||||||
|
|> Http.send CompletedSave
|
||||||
|
)
|
||||||
|
|
||||||
|
Err problems ->
|
||||||
|
( { model | problems = problems }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
EnteredEmail email ->
|
||||||
|
updateForm (\form -> { form | email = email }) model
|
||||||
|
|
||||||
|
EnteredUsername username ->
|
||||||
|
updateForm (\form -> { form | username = username }) model
|
||||||
|
|
||||||
|
EnteredPassword password ->
|
||||||
|
updateForm (\form -> { form | password = password }) model
|
||||||
|
|
||||||
|
EnteredBio bio ->
|
||||||
|
updateForm (\form -> { form | bio = bio }) model
|
||||||
|
|
||||||
|
EnteredAvatar avatar ->
|
||||||
|
updateForm (\form -> { form | avatar = avatar }) model
|
||||||
|
|
||||||
|
CompletedSave (Err error) ->
|
||||||
|
let
|
||||||
|
serverErrors =
|
||||||
|
Api.decodeErrors error
|
||||||
|
|> List.map ServerError
|
||||||
|
in
|
||||||
|
( { model | problems = List.append model.problems serverErrors }
|
||||||
|
, Cmd.none
|
||||||
|
)
|
||||||
|
|
||||||
|
CompletedSave (Ok cred) ->
|
||||||
|
( model
|
||||||
|
, Session.login cred
|
||||||
|
)
|
||||||
|
|
||||||
|
GotSession session ->
|
||||||
|
( { model | session = session }
|
||||||
|
, Route.replaceUrl (Session.navKey session) Route.Home
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Helper function for `update`. Updates the form and returns Cmd.none and
|
||||||
|
Ignored. Useful for recording form fields!
|
||||||
|
-}
|
||||||
|
updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
|
||||||
|
updateForm transform model =
|
||||||
|
( { model | form = transform model.form }, Cmd.none )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SUBSCRIPTIONS
|
||||||
|
|
||||||
|
|
||||||
|
subscriptions : Model -> Sub Msg
|
||||||
|
subscriptions model =
|
||||||
|
Session.changes GotSession (Session.navKey model.session)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- EXPORT
|
||||||
|
|
||||||
|
|
||||||
|
toSession : Model -> Session
|
||||||
|
toSession model =
|
||||||
|
model.session
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FORM
|
||||||
|
|
||||||
|
|
||||||
|
{-| Marks that we've trimmed the form's fields, so we don't accidentally send
|
||||||
|
it to the server without having trimmed it!
|
||||||
|
-}
|
||||||
|
type TrimmedForm
|
||||||
|
= Trimmed Form
|
||||||
|
|
||||||
|
|
||||||
|
{-| When adding a variant here, add it to `fieldsToValidate` too!
|
||||||
|
|
||||||
|
NOTE: there are no ImageUrl or Bio variants here, because they aren't validated!
|
||||||
|
|
||||||
|
-}
|
||||||
|
type ValidatedField
|
||||||
|
= Username
|
||||||
|
| Email
|
||||||
|
| Password
|
||||||
|
|
||||||
|
|
||||||
|
fieldsToValidate : List ValidatedField
|
||||||
|
fieldsToValidate =
|
||||||
|
[ Username
|
||||||
|
, Email
|
||||||
|
, Password
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Trim the form and validate its fields. If there are problems, report them!
|
||||||
|
-}
|
||||||
|
validate : Form -> Result (List Problem) TrimmedForm
|
||||||
|
validate form =
|
||||||
|
let
|
||||||
|
trimmedForm =
|
||||||
|
trimFields form
|
||||||
|
in
|
||||||
|
case List.concatMap (validateField trimmedForm) fieldsToValidate of
|
||||||
|
[] ->
|
||||||
|
Ok trimmedForm
|
||||||
|
|
||||||
|
problems ->
|
||||||
|
Err problems
|
||||||
|
|
||||||
|
|
||||||
|
validateField : TrimmedForm -> ValidatedField -> List Problem
|
||||||
|
validateField (Trimmed form) field =
|
||||||
|
List.map (InvalidEntry field) <|
|
||||||
|
case field of
|
||||||
|
Username ->
|
||||||
|
if String.isEmpty form.username then
|
||||||
|
[ "username can't be blank." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
Email ->
|
||||||
|
if String.isEmpty form.email then
|
||||||
|
[ "email can't be blank." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
Password ->
|
||||||
|
let
|
||||||
|
passwordLength =
|
||||||
|
String.length form.password
|
||||||
|
in
|
||||||
|
if passwordLength > 0 && passwordLength < Viewer.minPasswordChars then
|
||||||
|
[ "password must be at least " ++ String.fromInt Viewer.minPasswordChars ++ " characters long." ]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Don't trim while the user is typing! That would be super annoying.
|
||||||
|
Instead, trim only on submit.
|
||||||
|
-}
|
||||||
|
trimFields : Form -> TrimmedForm
|
||||||
|
trimFields form =
|
||||||
|
Trimmed
|
||||||
|
{ avatar = String.trim form.avatar
|
||||||
|
, bio = String.trim form.bio
|
||||||
|
, email = String.trim form.email
|
||||||
|
, username = String.trim form.username
|
||||||
|
, password = String.trim form.password
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- HTTP
|
||||||
|
|
||||||
|
|
||||||
|
{-| This takes a Valid Form as a reminder that it needs to have been validated
|
||||||
|
first.
|
||||||
|
-}
|
||||||
|
edit : Cred -> TrimmedForm -> Http.Request Viewer
|
||||||
|
edit cred (Trimmed form) =
|
||||||
|
let
|
||||||
|
encodedAvatar =
|
||||||
|
case form.avatar of
|
||||||
|
"" ->
|
||||||
|
Encode.null
|
||||||
|
|
||||||
|
avatar ->
|
||||||
|
Encode.string avatar
|
||||||
|
|
||||||
|
updates =
|
||||||
|
[ ( "username", Encode.string form.username )
|
||||||
|
, ( "email", Encode.string form.email )
|
||||||
|
, ( "bio", Encode.string form.bio )
|
||||||
|
, ( "image", encodedAvatar )
|
||||||
|
]
|
||||||
|
|
||||||
|
encodedUser =
|
||||||
|
Encode.object <|
|
||||||
|
case form.password of
|
||||||
|
"" ->
|
||||||
|
updates
|
||||||
|
|
||||||
|
password ->
|
||||||
|
( "password", Encode.string password ) :: updates
|
||||||
|
|
||||||
|
body =
|
||||||
|
Encode.object [ ( "user", encodedUser ) ]
|
||||||
|
|> Http.jsonBody
|
||||||
|
|
||||||
|
expect =
|
||||||
|
Decode.field "user" Viewer.decoder
|
||||||
|
|> Http.expectJson
|
||||||
|
in
|
||||||
|
Api.url [ "user" ]
|
||||||
|
|> HttpBuilder.put
|
||||||
|
|> HttpBuilder.withExpect expect
|
||||||
|
|> HttpBuilder.withBody body
|
||||||
|
|> Cred.addHeader cred
|
||||||
|
|> HttpBuilder.toRequest
|
||||||
|
|
||||||
|
|
||||||
|
nothingIfEmpty : String -> Maybe String
|
||||||
|
nothingIfEmpty str =
|
||||||
|
if String.isEmpty str then
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
else
|
||||||
|
Just str
|
||||||
98
intro/part5/src/PaginatedList.elm
Normal file
@@ -0,0 +1,98 @@
|
|||||||
|
module PaginatedList exposing (PaginatedList, fromList, map, mapPage, page, total, values, view)
|
||||||
|
|
||||||
|
import Html exposing (Html, a, li, text, ul)
|
||||||
|
import Html.Attributes exposing (class, classList, href)
|
||||||
|
import Html.Events exposing (onClick)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type PaginatedList a
|
||||||
|
= PaginatedList
|
||||||
|
{ values : List a
|
||||||
|
, total : Int
|
||||||
|
, page : Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INFO
|
||||||
|
|
||||||
|
|
||||||
|
values : PaginatedList a -> List a
|
||||||
|
values (PaginatedList info) =
|
||||||
|
info.values
|
||||||
|
|
||||||
|
|
||||||
|
total : PaginatedList a -> Int
|
||||||
|
total (PaginatedList info) =
|
||||||
|
info.total
|
||||||
|
|
||||||
|
|
||||||
|
page : PaginatedList a -> Int
|
||||||
|
page (PaginatedList info) =
|
||||||
|
info.page
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- CREATE
|
||||||
|
|
||||||
|
|
||||||
|
fromList : Int -> List a -> PaginatedList a
|
||||||
|
fromList totalCount list =
|
||||||
|
PaginatedList { values = list, total = totalCount, page = 1 }
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TRANSFORM
|
||||||
|
|
||||||
|
|
||||||
|
map : (a -> a) -> PaginatedList a -> PaginatedList a
|
||||||
|
map transform (PaginatedList info) =
|
||||||
|
PaginatedList { info | values = List.map transform info.values }
|
||||||
|
|
||||||
|
|
||||||
|
mapPage : (Int -> Int) -> PaginatedList a -> PaginatedList a
|
||||||
|
mapPage transform (PaginatedList info) =
|
||||||
|
PaginatedList { info | page = transform info.page }
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : (Int -> msg) -> PaginatedList a -> Int -> Html msg
|
||||||
|
view toMsg list resultsPerPage =
|
||||||
|
let
|
||||||
|
totalPages =
|
||||||
|
ceiling (toFloat (total list) / toFloat resultsPerPage)
|
||||||
|
|
||||||
|
activePage =
|
||||||
|
page list
|
||||||
|
|
||||||
|
viewPageLink currentPage =
|
||||||
|
pageLink toMsg currentPage (currentPage == activePage)
|
||||||
|
in
|
||||||
|
if totalPages > 1 then
|
||||||
|
List.range 1 totalPages
|
||||||
|
|> List.map viewPageLink
|
||||||
|
|> ul [ class "pagination" ]
|
||||||
|
|
||||||
|
else
|
||||||
|
Html.text ""
|
||||||
|
|
||||||
|
|
||||||
|
pageLink : (Int -> msg) -> Int -> Bool -> Html msg
|
||||||
|
pageLink toMsg targetPage isActive =
|
||||||
|
li [ classList [ ( "page-item", True ), ( "active", isActive ) ] ]
|
||||||
|
[ a
|
||||||
|
[ class "page-link"
|
||||||
|
, onClick (toMsg targetPage)
|
||||||
|
|
||||||
|
-- The RealWorld CSS requires an href to work properly.
|
||||||
|
, href ""
|
||||||
|
]
|
||||||
|
[ text (String.fromInt targetPage) ]
|
||||||
|
]
|
||||||
56
intro/part5/src/Profile.elm
Normal file
@@ -0,0 +1,56 @@
|
|||||||
|
module Profile exposing (Profile, avatar, bio, decoder)
|
||||||
|
|
||||||
|
{-| A user's profile - potentially your own!
|
||||||
|
|
||||||
|
Contrast with Cred, which is the currently signed-in user.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Api
|
||||||
|
import Avatar exposing (Avatar)
|
||||||
|
import Http
|
||||||
|
import HttpBuilder exposing (RequestBuilder, withExpect)
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Decode.Pipeline exposing (required)
|
||||||
|
import Username exposing (Username)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Profile
|
||||||
|
= Profile Internals
|
||||||
|
|
||||||
|
|
||||||
|
type alias Internals =
|
||||||
|
{ bio : Maybe String
|
||||||
|
, avatar : Avatar
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INFO
|
||||||
|
|
||||||
|
|
||||||
|
bio : Profile -> Maybe String
|
||||||
|
bio (Profile info) =
|
||||||
|
info.bio
|
||||||
|
|
||||||
|
|
||||||
|
avatar : Profile -> Avatar
|
||||||
|
avatar (Profile info) =
|
||||||
|
info.avatar
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SERIALIZATION
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder Profile
|
||||||
|
decoder =
|
||||||
|
Decode.succeed Internals
|
||||||
|
|> required "bio" (Decode.nullable Decode.string)
|
||||||
|
|> required "image" Avatar.decoder
|
||||||
|
|> Decode.map Profile
|
||||||
107
intro/part5/src/Route.elm
Normal file
@@ -0,0 +1,107 @@
|
|||||||
|
module Route exposing (Route(..), fromUrl, href, replaceUrl)
|
||||||
|
|
||||||
|
import Article.Slug as Slug exposing (Slug)
|
||||||
|
import Browser.Navigation as Nav
|
||||||
|
import Html exposing (Attribute)
|
||||||
|
import Html.Attributes as Attr
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Url exposing (Url)
|
||||||
|
import Url.Parser as Parser exposing ((</>), Parser, oneOf, s, string)
|
||||||
|
import Username exposing (Username)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- ROUTING
|
||||||
|
|
||||||
|
|
||||||
|
type Route
|
||||||
|
= Home
|
||||||
|
| Root
|
||||||
|
| Login
|
||||||
|
| Logout
|
||||||
|
| Register
|
||||||
|
| Settings
|
||||||
|
| Article Slug
|
||||||
|
| Profile Username
|
||||||
|
| NewArticle
|
||||||
|
| EditArticle Slug
|
||||||
|
|
||||||
|
|
||||||
|
parser : Parser (Route -> a) a
|
||||||
|
parser =
|
||||||
|
oneOf
|
||||||
|
[ Parser.map Home Parser.top
|
||||||
|
, Parser.map Login (s "login")
|
||||||
|
, Parser.map Logout (s "logout")
|
||||||
|
, Parser.map Settings (s "settings")
|
||||||
|
, Parser.map Profile (s "profile" </> Username.urlParser)
|
||||||
|
, Parser.map Register (s "register")
|
||||||
|
, Parser.map Article (s "article" </> Slug.urlParser)
|
||||||
|
, Parser.map NewArticle (s "editor")
|
||||||
|
, Parser.map EditArticle (s "editor" </> Slug.urlParser)
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- PUBLIC HELPERS
|
||||||
|
|
||||||
|
|
||||||
|
href : Route -> Attribute msg
|
||||||
|
href targetRoute =
|
||||||
|
Attr.href (routeToString targetRoute)
|
||||||
|
|
||||||
|
|
||||||
|
replaceUrl : Nav.Key -> Route -> Cmd msg
|
||||||
|
replaceUrl key route =
|
||||||
|
Nav.replaceUrl key (routeToString route)
|
||||||
|
|
||||||
|
|
||||||
|
fromUrl : Url -> Maybe Route
|
||||||
|
fromUrl url =
|
||||||
|
-- The RealWorld spec treats the fragment like a path.
|
||||||
|
-- This makes it *literally* the path, so we can proceed
|
||||||
|
-- with parsing as if it had been a normal path all along.
|
||||||
|
{ url | path = Maybe.withDefault "" url.fragment, fragment = Nothing }
|
||||||
|
|> Parser.parse parser
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INTERNAL
|
||||||
|
|
||||||
|
|
||||||
|
routeToString : Route -> String
|
||||||
|
routeToString page =
|
||||||
|
let
|
||||||
|
pieces =
|
||||||
|
case page of
|
||||||
|
Home ->
|
||||||
|
[]
|
||||||
|
|
||||||
|
Root ->
|
||||||
|
[]
|
||||||
|
|
||||||
|
Login ->
|
||||||
|
[ "login" ]
|
||||||
|
|
||||||
|
Logout ->
|
||||||
|
[ "logout" ]
|
||||||
|
|
||||||
|
Register ->
|
||||||
|
[ "register" ]
|
||||||
|
|
||||||
|
Settings ->
|
||||||
|
[ "settings" ]
|
||||||
|
|
||||||
|
Article slug ->
|
||||||
|
[ "article", Slug.toString slug ]
|
||||||
|
|
||||||
|
Profile username ->
|
||||||
|
[ "profile", Username.toString username ]
|
||||||
|
|
||||||
|
NewArticle ->
|
||||||
|
[ "editor" ]
|
||||||
|
|
||||||
|
EditArticle slug ->
|
||||||
|
[ "editor", Slug.toString slug ]
|
||||||
|
in
|
||||||
|
"#/" ++ String.join "/" pieces
|
||||||
116
intro/part5/src/Session.elm
Normal file
@@ -0,0 +1,116 @@
|
|||||||
|
port module Session
|
||||||
|
exposing
|
||||||
|
( Session
|
||||||
|
, changes
|
||||||
|
, cred
|
||||||
|
, decode
|
||||||
|
, login
|
||||||
|
, logout
|
||||||
|
, navKey
|
||||||
|
, viewer
|
||||||
|
)
|
||||||
|
|
||||||
|
import Browser.Navigation as Nav
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Decode.Pipeline exposing (custom, required)
|
||||||
|
import Json.Encode as Encode exposing (Value)
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Time
|
||||||
|
import Viewer exposing (Viewer)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Session
|
||||||
|
= LoggedIn Nav.Key Viewer
|
||||||
|
| Guest Nav.Key
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INFO
|
||||||
|
|
||||||
|
|
||||||
|
viewer : Session -> Maybe Viewer
|
||||||
|
viewer session =
|
||||||
|
case session of
|
||||||
|
LoggedIn _ val ->
|
||||||
|
Just val
|
||||||
|
|
||||||
|
Guest _ ->
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
|
||||||
|
cred : Session -> Maybe Cred
|
||||||
|
cred session =
|
||||||
|
case session of
|
||||||
|
LoggedIn _ val ->
|
||||||
|
Just (Viewer.cred val)
|
||||||
|
|
||||||
|
Guest _ ->
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
|
||||||
|
navKey : Session -> Nav.Key
|
||||||
|
navKey session =
|
||||||
|
case session of
|
||||||
|
LoggedIn key _ ->
|
||||||
|
key
|
||||||
|
|
||||||
|
Guest key ->
|
||||||
|
key
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- LOGIN
|
||||||
|
|
||||||
|
|
||||||
|
login : Viewer -> Cmd msg
|
||||||
|
login newViewer =
|
||||||
|
Viewer.encode newViewer
|
||||||
|
|> Encode.encode 0
|
||||||
|
|> Just
|
||||||
|
|> storeSession
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- LOGOUT
|
||||||
|
|
||||||
|
|
||||||
|
logout : Cmd msg
|
||||||
|
logout =
|
||||||
|
storeSession Nothing
|
||||||
|
|
||||||
|
|
||||||
|
port storeSession : Maybe String -> Cmd msg
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- CHANGES
|
||||||
|
|
||||||
|
|
||||||
|
changes : (Session -> msg) -> Nav.Key -> Sub msg
|
||||||
|
changes toMsg key =
|
||||||
|
onSessionChange (\val -> toMsg (decode key val))
|
||||||
|
|
||||||
|
|
||||||
|
port onSessionChange : (Value -> msg) -> Sub msg
|
||||||
|
|
||||||
|
|
||||||
|
decode : Nav.Key -> Value -> Session
|
||||||
|
decode key value =
|
||||||
|
-- It's stored in localStorage as a JSON String;
|
||||||
|
-- first decode the Value as a String, then
|
||||||
|
-- decode that String as JSON.
|
||||||
|
case
|
||||||
|
Decode.decodeValue Decode.string value
|
||||||
|
|> Result.andThen (Decode.decodeString Viewer.decoder)
|
||||||
|
|> Result.toMaybe
|
||||||
|
of
|
||||||
|
Just decodedViewer ->
|
||||||
|
LoggedIn key decodedViewer
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Guest key
|
||||||
100
intro/part5/src/Timestamp.elm
Normal file
@@ -0,0 +1,100 @@
|
|||||||
|
module Timestamp exposing (format, iso8601Decoder, view)
|
||||||
|
|
||||||
|
import Html exposing (Html, span, text)
|
||||||
|
import Html.Attributes exposing (class)
|
||||||
|
import Iso8601
|
||||||
|
import Json.Decode as Decode exposing (Decoder, fail, succeed)
|
||||||
|
import Time exposing (Month(..))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- VIEW
|
||||||
|
|
||||||
|
|
||||||
|
view : Time.Zone -> Time.Posix -> Html msg
|
||||||
|
view timeZone timestamp =
|
||||||
|
span [ class "date" ] [ text (format timeZone timestamp) ]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- DECODE
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode an ISO-8601 date string.
|
||||||
|
-}
|
||||||
|
iso8601Decoder : Decoder Time.Posix
|
||||||
|
iso8601Decoder =
|
||||||
|
Decode.string
|
||||||
|
|> Decode.andThen fromString
|
||||||
|
|
||||||
|
|
||||||
|
fromString : String -> Decoder Time.Posix
|
||||||
|
fromString str =
|
||||||
|
case Iso8601.toTime str of
|
||||||
|
Ok successValue ->
|
||||||
|
succeed successValue
|
||||||
|
|
||||||
|
Err _ ->
|
||||||
|
fail ("Invalid date: " ++ str)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- FORMAT
|
||||||
|
|
||||||
|
|
||||||
|
{-| Format a timestamp as a String, like so:
|
||||||
|
|
||||||
|
"February 14, 2018"
|
||||||
|
|
||||||
|
For more complex date formatting scenarios, here's a nice package:
|
||||||
|
<https://package.elm-lang.org/packages/ryannhg/date-format/latest/>
|
||||||
|
|
||||||
|
-}
|
||||||
|
format : Time.Zone -> Time.Posix -> String
|
||||||
|
format zone time =
|
||||||
|
let
|
||||||
|
month =
|
||||||
|
case Time.toMonth zone time of
|
||||||
|
Jan ->
|
||||||
|
"January"
|
||||||
|
|
||||||
|
Feb ->
|
||||||
|
"February"
|
||||||
|
|
||||||
|
Mar ->
|
||||||
|
"March"
|
||||||
|
|
||||||
|
Apr ->
|
||||||
|
"April"
|
||||||
|
|
||||||
|
May ->
|
||||||
|
"May"
|
||||||
|
|
||||||
|
Jun ->
|
||||||
|
"June"
|
||||||
|
|
||||||
|
Jul ->
|
||||||
|
"July"
|
||||||
|
|
||||||
|
Aug ->
|
||||||
|
"August"
|
||||||
|
|
||||||
|
Sep ->
|
||||||
|
"September"
|
||||||
|
|
||||||
|
Oct ->
|
||||||
|
"October"
|
||||||
|
|
||||||
|
Nov ->
|
||||||
|
"November"
|
||||||
|
|
||||||
|
Dec ->
|
||||||
|
"December"
|
||||||
|
|
||||||
|
day =
|
||||||
|
String.fromInt (Time.toDay zone time)
|
||||||
|
|
||||||
|
year =
|
||||||
|
String.fromInt (Time.toYear zone time)
|
||||||
|
in
|
||||||
|
month ++ " " ++ day ++ ", " ++ year
|
||||||
47
intro/part5/src/Username.elm
Normal file
@@ -0,0 +1,47 @@
|
|||||||
|
module Username exposing (Username, decoder, encode, toHtml, toString, urlParser)
|
||||||
|
|
||||||
|
import Html exposing (Html)
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Encode as Encode exposing (Value)
|
||||||
|
import Url.Parser
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Username
|
||||||
|
= Username String
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- CREATE
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder Username
|
||||||
|
decoder =
|
||||||
|
Decode.map Username Decode.string
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TRANSFORM
|
||||||
|
|
||||||
|
|
||||||
|
encode : Username -> Value
|
||||||
|
encode (Username username) =
|
||||||
|
Encode.string username
|
||||||
|
|
||||||
|
|
||||||
|
toString : Username -> String
|
||||||
|
toString (Username username) =
|
||||||
|
username
|
||||||
|
|
||||||
|
|
||||||
|
urlParser : Url.Parser.Parser (Username -> a) a
|
||||||
|
urlParser =
|
||||||
|
Url.Parser.custom "USERNAME" (\str -> Just (Username str))
|
||||||
|
|
||||||
|
|
||||||
|
toHtml : Username -> Html msg
|
||||||
|
toHtml (Username username) =
|
||||||
|
Html.text username
|
||||||
85
intro/part5/src/Viewer.elm
Normal file
@@ -0,0 +1,85 @@
|
|||||||
|
module Viewer exposing (Viewer, cred, decoder, email, encode, minPasswordChars, profile)
|
||||||
|
|
||||||
|
{-| The logged-in user currently viewing this page.
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Avatar exposing (Avatar)
|
||||||
|
import Email exposing (Email)
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Decode.Pipeline exposing (custom, required)
|
||||||
|
import Json.Encode as Encode exposing (Value)
|
||||||
|
import Profile exposing (Profile)
|
||||||
|
import Username exposing (Username)
|
||||||
|
import Viewer.Cred as Cred exposing (Cred)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Viewer
|
||||||
|
= Viewer Internals
|
||||||
|
|
||||||
|
|
||||||
|
type alias Internals =
|
||||||
|
{ cred : Cred
|
||||||
|
, profile : Profile
|
||||||
|
, email : Email
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INFO
|
||||||
|
|
||||||
|
|
||||||
|
cred : Viewer -> Cred
|
||||||
|
cred (Viewer info) =
|
||||||
|
info.cred
|
||||||
|
|
||||||
|
|
||||||
|
profile : Viewer -> Profile
|
||||||
|
profile (Viewer info) =
|
||||||
|
info.profile
|
||||||
|
|
||||||
|
|
||||||
|
email : Viewer -> Email
|
||||||
|
email (Viewer info) =
|
||||||
|
info.email
|
||||||
|
|
||||||
|
|
||||||
|
{-| Passwords must be at least this many characters long!
|
||||||
|
-}
|
||||||
|
minPasswordChars : Int
|
||||||
|
minPasswordChars =
|
||||||
|
6
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SERIALIZATION
|
||||||
|
|
||||||
|
|
||||||
|
encode : Viewer -> Value
|
||||||
|
encode (Viewer info) =
|
||||||
|
Encode.object
|
||||||
|
[ ( "email", Email.encode info.email )
|
||||||
|
, ( "username", Username.encode (Cred.username info.cred) )
|
||||||
|
, ( "image", Avatar.encode (Profile.avatar info.profile) )
|
||||||
|
, ( "token", Cred.encodeToken info.cred )
|
||||||
|
, ( "bio"
|
||||||
|
, case Profile.bio info.profile of
|
||||||
|
Just bio ->
|
||||||
|
Encode.string bio
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Encode.null
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder Viewer
|
||||||
|
decoder =
|
||||||
|
Decode.succeed Internals
|
||||||
|
|> custom Cred.decoder
|
||||||
|
|> custom Profile.decoder
|
||||||
|
|> required "email" Email.decoder
|
||||||
|
|> Decode.map Viewer
|
||||||
85
intro/part5/src/Viewer/Cred.elm
Normal file
@@ -0,0 +1,85 @@
|
|||||||
|
module Viewer.Cred exposing (Cred, addHeader, addHeaderIfAvailable, decoder, encodeToken, username)
|
||||||
|
|
||||||
|
{-| The authentication credentials for the Viewer (that is, the currently logged-in user.)
|
||||||
|
|
||||||
|
This includes:
|
||||||
|
|
||||||
|
- The cred's Username
|
||||||
|
- The cred's authentication token
|
||||||
|
|
||||||
|
By design, there is no way to access the token directly as a String.
|
||||||
|
It can be encoded for persistence, and it can be added to a header
|
||||||
|
to a HttpBuilder for a request, but that's it.
|
||||||
|
|
||||||
|
This token should never be rendered to the end user, and with this API, it
|
||||||
|
can't be!
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import HttpBuilder exposing (RequestBuilder, withHeader)
|
||||||
|
import Json.Decode as Decode exposing (Decoder)
|
||||||
|
import Json.Decode.Pipeline exposing (required)
|
||||||
|
import Json.Encode as Encode exposing (Value)
|
||||||
|
import Username exposing (Username)
|
||||||
|
|
||||||
|
|
||||||
|
{-| The authentication token for the currently logged-in user.
|
||||||
|
|
||||||
|
The token records the username associated with this token, which you can ask it for.
|
||||||
|
|
||||||
|
By design, there is no way to access the token directly as a String. You can encode it for persistence, and you can add it to a header to a HttpBuilder for a request, but that's it.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TYPES
|
||||||
|
|
||||||
|
|
||||||
|
type Cred
|
||||||
|
= Cred Username String
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- INFO
|
||||||
|
|
||||||
|
|
||||||
|
username : Cred -> Username
|
||||||
|
username (Cred val _) =
|
||||||
|
val
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- SERIALIZATION
|
||||||
|
|
||||||
|
|
||||||
|
decoder : Decoder Cred
|
||||||
|
decoder =
|
||||||
|
Decode.succeed Cred
|
||||||
|
|> required "username" Username.decoder
|
||||||
|
|> required "token" Decode.string
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TRANSFORM
|
||||||
|
|
||||||
|
|
||||||
|
encodeToken : Cred -> Value
|
||||||
|
encodeToken (Cred _ str) =
|
||||||
|
Encode.string str
|
||||||
|
|
||||||
|
|
||||||
|
addHeader : Cred -> RequestBuilder a -> RequestBuilder a
|
||||||
|
addHeader (Cred _ str) builder =
|
||||||
|
builder
|
||||||
|
|> withHeader "authorization" ("Token " ++ str)
|
||||||
|
|
||||||
|
|
||||||
|
addHeaderIfAvailable : Maybe Cred -> RequestBuilder a -> RequestBuilder a
|
||||||
|
addHeaderIfAvailable maybeCred builder =
|
||||||
|
case maybeCred of
|
||||||
|
Just cred ->
|
||||||
|
addHeader cred builder
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
builder
|
||||||