From fd7776fd91be68baa28870a47781d3356c0e73dd Mon Sep 17 00:00:00 2001 From: Richard Feldman Date: Thu, 1 Feb 2018 06:52:27 -0500 Subject: [PATCH] Upgrade to 0.19, rearchitect everything! --- Makefile | 15 + README.md | 12 +- assets/icons/android-chrome-192x192.png | Bin 0 -> 2774 bytes assets/icons/android-chrome-512x512.png | Bin 0 -> 9631 bytes assets/icons/apple-touch-icon.png | Bin 0 -> 2327 bytes assets/icons/browserconfig.xml | 9 + assets/icons/favicon-16x16.png | Bin 0 -> 736 bytes assets/icons/favicon-32x32.png | Bin 0 -> 985 bytes assets/icons/favicon.ico | Bin 0 -> 15086 bytes assets/icons/mstile-144x144.png | Bin 0 -> 1956 bytes assets/icons/mstile-150x150.png | Bin 0 -> 2285 bytes assets/icons/mstile-310x150.png | Bin 0 -> 2542 bytes assets/icons/mstile-310x310.png | Bin 0 -> 4166 bytes assets/icons/mstile-70x70.png | Bin 0 -> 1563 bytes assets/icons/safari-pinned-tab.svg | 29 + assets/images/loading.svg | 17 + assets/images/smiley-cyrus.jpg | Bin 0 -> 1343 bytes assets/site.webmanifest | 19 + elm-package.json | 26 - elm.json | 33 + index.html | 36 +- src/Api.elm | 300 +++++++++ src/Api/Endpoint.elm | 127 ++++ src/Article.elm | 274 +++++++++ src/Article/Body.elm | 38 ++ src/Article/Comment.elm | 108 ++++ src/Article/Feed.elm | 279 +++++++++ src/Article/Slug.elm | 35 ++ src/Article/Tag.elm | 42 ++ src/{Views/Assets.elm => Asset.elm} | 23 +- src/Author.elm | 234 +++++++ src/Avatar.elm | 56 ++ src/CommentId.elm | 29 + src/Data/Article.elm | 154 ----- src/Data/Article/Author.elm | 23 - src/Data/Article/Comment.elm | 48 -- src/Data/Article/Feed.elm | 22 - src/Data/AuthToken.elm | 31 - src/Data/Profile.elm | 23 - src/Data/Session.elm | 19 - src/Data/User.elm | 84 --- src/Data/UserPhoto.elm | 45 -- src/Email.elm | 45 ++ src/Loading.elm | 31 + src/Log.elm | 20 + src/Main.elm | 572 +++++++----------- src/{Views => }/Page.elm | 114 ++-- src/Page/Article.elm | 771 +++++++++++++++--------- src/Page/Article/Editor.elm | 682 ++++++++++++++++----- src/Page/Blank.elm | 10 + src/Page/Errored.elm | 45 -- src/Page/Home.elm | 404 ++++++++++--- src/Page/Login.elm | 378 ++++++++---- src/Page/NotFound.elm | 23 +- src/Page/Profile.elm | 503 ++++++++++++---- src/Page/Register.elm | 389 ++++++++---- src/Page/Settings.elm | 578 ++++++++++++------ src/PaginatedList.elm | 70 +++ src/Ports.elm | 9 - src/Profile.elm | 54 ++ src/Request/Article.elm | 272 --------- src/Request/Article/Comments.elm | 54 -- src/Request/Helpers.elm | 6 - src/Request/Profile.elm | 57 -- src/Request/User.elm | 95 --- src/Route.elm | 94 +-- src/Session.elm | 76 +++ src/Timestamp.elm | 100 +++ src/Username.elm | 47 ++ src/Util.elm | 50 -- src/Viewer.elm | 66 ++ src/Views/Article.elm | 60 -- src/Views/Article/Favorite.elm | 42 -- src/Views/Article/Feed.elm | 415 ------------- src/Views/Author.elm | 16 - src/Views/Errors.elm | 30 - src/Views/Form.elm | 40 -- src/Views/Spinner.elm | 14 - src/Views/User/Follow.elm | 41 -- tests/RoutingTests.elm | 80 ++- 80 files changed, 5212 insertions(+), 3331 deletions(-) create mode 100644 Makefile create mode 100644 assets/icons/android-chrome-192x192.png create mode 100644 assets/icons/android-chrome-512x512.png create mode 100644 assets/icons/apple-touch-icon.png create mode 100644 assets/icons/browserconfig.xml create mode 100644 assets/icons/favicon-16x16.png create mode 100644 assets/icons/favicon-32x32.png create mode 100644 assets/icons/favicon.ico create mode 100644 assets/icons/mstile-144x144.png create mode 100644 assets/icons/mstile-150x150.png create mode 100644 assets/icons/mstile-310x150.png create mode 100644 assets/icons/mstile-310x310.png create mode 100644 assets/icons/mstile-70x70.png create mode 100644 assets/icons/safari-pinned-tab.svg create mode 100644 assets/images/loading.svg create mode 100644 assets/images/smiley-cyrus.jpg create mode 100644 assets/site.webmanifest delete mode 100644 elm-package.json create mode 100644 elm.json create mode 100644 src/Api.elm create mode 100644 src/Api/Endpoint.elm create mode 100644 src/Article.elm create mode 100644 src/Article/Body.elm create mode 100644 src/Article/Comment.elm create mode 100644 src/Article/Feed.elm create mode 100644 src/Article/Slug.elm create mode 100644 src/Article/Tag.elm rename src/{Views/Assets.elm => Asset.elm} (55%) create mode 100644 src/Author.elm create mode 100644 src/Avatar.elm create mode 100644 src/CommentId.elm delete mode 100644 src/Data/Article.elm delete mode 100644 src/Data/Article/Author.elm delete mode 100644 src/Data/Article/Comment.elm delete mode 100644 src/Data/Article/Feed.elm delete mode 100644 src/Data/AuthToken.elm delete mode 100644 src/Data/Profile.elm delete mode 100644 src/Data/Session.elm delete mode 100644 src/Data/User.elm delete mode 100644 src/Data/UserPhoto.elm create mode 100644 src/Email.elm create mode 100644 src/Loading.elm create mode 100644 src/Log.elm rename src/{Views => }/Page.elm (53%) create mode 100644 src/Page/Blank.elm delete mode 100644 src/Page/Errored.elm create mode 100644 src/PaginatedList.elm delete mode 100644 src/Ports.elm create mode 100644 src/Profile.elm delete mode 100644 src/Request/Article.elm delete mode 100644 src/Request/Article/Comments.elm delete mode 100644 src/Request/Helpers.elm delete mode 100644 src/Request/Profile.elm delete mode 100644 src/Request/User.elm create mode 100644 src/Session.elm create mode 100644 src/Timestamp.elm create mode 100644 src/Username.elm delete mode 100644 src/Util.elm create mode 100644 src/Viewer.elm delete mode 100644 src/Views/Article.elm delete mode 100644 src/Views/Article/Favorite.elm delete mode 100644 src/Views/Article/Feed.elm delete mode 100644 src/Views/Author.elm delete mode 100644 src/Views/Errors.elm delete mode 100644 src/Views/Form.elm delete mode 100644 src/Views/Spinner.elm delete mode 100644 src/Views/User/Follow.elm diff --git a/Makefile b/Makefile new file mode 100644 index 0000000000..5f50e0a3c8 --- /dev/null +++ b/Makefile @@ -0,0 +1,15 @@ + +MAIN_FILE = src/Main.elm +OUTPUT_FILE = elm.js +RUN_UGLIFY = npx uglify-js $(OUTPUT_FILE) --output=$(OUTPUT_FILE) + +.PHONY: production dev test + +production: + npx elm make --optimize $(MAIN_FILE) --output=$(OUTPUT_FILE) && echo "Uglifying output..." && $(RUN_UGLIFY) --compress --mangle + +dev: + npx elm-live $(MAIN_FILE) --output=$(OUTPUT_FILE) --pushstate --debug + +test: + npx elm-test diff --git a/README.md b/README.md index 8becc83203..09c9de30c7 100644 --- a/README.md +++ b/README.md @@ -19,12 +19,14 @@ Check out [the full writeup](https://dev.to/rtfeldman/tour-of-an-open-source-elm # Getting started -If you don't already have `elm` and `elm-live`: +I set this up with `make` to show that you can make a SPA in Elm with any +build tool you like! It takes very little configuration. -> npm install -g elm elm-live +To build production assets (including minification): -Then, to build everything: +> make -> elm-live --output=elm.js src/Main.elm --pushstate --open --debug +To build local development (including the time-traveling debugger) + +> make dev -(Leave off the `--debug` if you don't want the time-traveling debugger.) diff --git a/assets/icons/android-chrome-192x192.png b/assets/icons/android-chrome-192x192.png new file mode 100644 index 0000000000000000000000000000000000000000..ff83974ad3f0957dce04cf055cf43f880a0044e4 GIT binary patch literal 2774 zcmZ`)3s4i+8a}((goJ=Rkfg*^2g*V*a0^1pZqZW=1!1<# z{iGfZM{6kF!cfy8gl*wH$*=m{7T%|G#R;*AAWVOZW^-i-4LhozA9}SW+_pMm7{4a} zx+?NW$bSd#cdzwmY(D41e?O8s0U0yn)!``etEIm$sEq!=OIvs-ra#?3wql;4EiOY) z{?1Pn|F>PjL1SiOFjsg$yU&yn{lS#CEY`sN;+yH(*I98drme_+DG2m_zB0#G7q6MM zYRXh`!ZTxjuFs2^lM@FDmV5U-4-ghk%JZ7?jHUkO)r`q2`X=#KKJEANU-e{SzTbq$ ze-{*T)Oj0~k?{P;vgpWgu#G;R4*{!?pYkmL%()*QWb=LpE+nmrqhcbgp3qU6qvOV3 zH1+^6qNBn?g{6OX_UM})ggYzWOdVra@?B~5@$M(58~AUmoKxgD+qq;bdhOxEhk-rA zy4~J~9`q~}4;;Q&vi7-Y@2xK{8p+B%o<)ww#kn1f&G%L|?_P57U$dvu#hL4Vl|6nN zaY*bdxX2bdw~C9<^XqI{U5e1a4(5gScsau{!iMezC7Hi_U`L65jH?ta zJJ}{XTn;<5@K`p)C2R`52=(H4m$?Ia%L%Rq^m%E}aL0a^=^CtWqK1(@u@Str?*=K% zI@o7keA#&WsK!V_iSRSj=p_F_l;O1DYnT3OHf{^2aB(oJ^^uW(>(?961cHa|t!4^{ zz4RdbH*^vw4RP632Wo!q@Cyp&DF^A0X{(*wfp^)Gw0I3YdiC}qne4Z zINpHVI$nZB;50t#oT*06+y-So$EfZaqflQwOr<@^Y$ICx;@f49I_f1cg*G#R^^P2S zH{%=B4m8M*DtvZaVQmDJvfGk6C0ps;IOs)}z!oNKzsV_;3@Y;`B2{y*|GCrgJsO1F zmi(j~2k71#SoS2dEQBK@wEjOPddL8N5cKGrHvzd?SObQt#M0bcR}2}UU%uNxjtO;B zCga*BHi}44m6TD_>&v9$t>t{=qQd94))}KQ_Txl7 z+f}PbR3dWbC1VRV9bDqb74wxeLiX;&Cd2k88^0%5gcCM2j=q#=wQd4~8S2gg$42CV z?9t{{l7V;vYrl#!!x{a5^}6uTe)NQCKj9>DYShnfoqV$#5fr}ME0D%7Wza8y7#{at z1N$H%4%HRim&7P-3E8w0n+?^(c$Euta6U3u)c9mU3@{|0(bJF+V12s61-^Ohfgg}r zWkM-;7r@IFn*|({$9!*e#R7=^c#SljgSk1h4c=iL0~MlYfdOR1>Us~kG>z75VpN-w zX8(v7X1Atl#O|S;{&babGj^5?BRWhA8kd~NV5kOM?c0a91KeDZdJL=0AG^T?C7bFm zr}26Hu3%6H$Q%|{5@5ZB93gf~CWJn`GiJGdJF`NPPgG~%szHA-!_C-3mz(|4fkrWI za3*^IA!pVRrpx2WI<&rOEHLWEku_tmVJp_4B$ha@a12&XTyF5Je3gp@8Okxax!QdZ zakeT#rOl;r4DOg+li?yDBek77*A7{+ZODZnTblBf%S4|39Z-=K>eV&M?mH-F(2Chk zdVp^8rrO?ARmUB`8A_IU&%@$6yMpWWTWPp?j!HVpIymPA&y#z1t3aLFup5a>8qz@^0Wrtw;qx2mn_(?Xe*KhalFz!Z^6(O8v zh2y1u=UHUKLE~k_242gSURUKG4XpGuU8jyE()!=*S}E&tASK{}q!x7Q=o&@q{Q?KI z;X5EV-%^`m5sh@k7Wh4S$LMtSBI8RiBsmHm#xaWJ9lY8RqPtAfq=W*(m8AC_uzMYaf zJky}?j0{PT|MANIrl&pntlzwPCFxVP;G(COAZj>SR^@?usb6Fp9-{k76^Zf$T?uP% zz4^fECNJ#YE#|Ip!z*-Os3M7nzUN+-9Kv%t3LH)a8>Y4D#AP>*K||3?oukiuv!`@N zOJ}gO91B$I`i!^GeesHTd69NDOSp(+l-;ORa0TW1CTy&_%5YWT4nJq0KrS*%pXR@_ zKQ&@lQ+A^VTq=kh4G?R-X78hq{7U#^# zD$0Qi2;j{K;_?EyyZ|9@=A0QpFsAVW=J0sJ5RjspA9p9_Lv9_?jI*4 z7Kn>WGK+FRNlA%cUjB-2voZ^F{0fS44-Eu=21Uv1g^P<5GD|pxMFrx#l{uW^b%i;c zyu#uv07@&LzO`YlUgYC*BkpE<)UyOY^J4pDv7Nk}qW3t{oH*gctSi|xud_nV&F*_` kSKF_8T(!DM@Z}5qfY#Na_-$C=J~#qIMZ|`m4im}#2h)4vC;$Ke literal 0 HcmV?d00001 diff --git a/assets/icons/android-chrome-512x512.png b/assets/icons/android-chrome-512x512.png new file mode 100644 index 0000000000000000000000000000000000000000..ec8f58163e057f4a7d03cc14ca0b49c766d053bd GIT binary patch literal 9631 zcmZ{KdpuP6|Nr|Or;M~XRIWucNF_#6LQHEAa#`JUHIfvGN~zEs+ZHm|9fdA3yRF+w zZ1+;ke$rT_*brUWrYlJ!G-b^BzK%YhKYoAw9zAf*`|^6fUeDL-{dzy&uTw^FpwD*` zOeP?NzVlte4?zfrM;x)n!=J&uZC~LJ5w$pAF+zXlXsg1HGAMe@xw7oM+)>(}r;%X}1pR;&>=e>E< z^G(*f`kyA<-`7=oqyNn(d&}m11I_(O%_+^-((V_!<_Da*F7GL|-1pj>=C&MJHDlq9 zp0}04)i0`ZOXHFRVn^TSrNg(w-|57C)jjR9zxRSTd3B#QTDvb;>{$BY>eoVlvpua& zt46nq4SY8&8+lQkV5-Su;{xkwzEqKp%AzaK5L&Nc3rbG_qu)%`g5UF>cJ6Z$b~V_Ll0WWgwdv z@tD~9gBSK&^9X6v(kUo|MIG0}xSqM=c{`(sWUszVd@W3M%+=(HPl4tOya--DsIugj zv8ntl*2gOv0z9p%=HGWgGj|uTsMR)8F`+(*&bXd>d7Oeat5V?SGVvB9om>U0T|R-akWiFB7Xm2t@F}fSB}9@#G-y_ zoA_U4xj#PspR$+RzDJh3+1*<&*?+gqi;zxPqcx^PEGQ93NDr@>Ky8|g(dXO3Axsw& z((!AwDa(DA!IPG_AYjfn<-lE@75|f{Q}&99y=r$7X}0VK;nOB2@9*>1Si3J&yeb2A zuGPijZC-J@W7xPPQ8$N0EgI58jqAye_I^`szIi3XQn(y;S^7we{f( z*6(V6boRNH9yYJCbZnL5X;DK0aN4K++Kh20Ni05fnuZ05NjLM+sg4+AImGS`Yp-># zo=l>5u1H+N?$-93x)=6;b2^K9o`I%ReMU=Gk{`{$<-SDqmR+p>3bK8;4j&Vg9E39G z{dc)DBxc+6^jkY0WzKCtOM1Mdb>~uc2xhaX+Xb*-qL=hdzRO40^mNP^iq))LIt+@< zlQHQD2s$ut-N*~uhNs{3^z)JSp5H%%M+DdF|4;CROGn4dGbW|Bb7nH(xNUPfb!9e$ zgyg57N6++8;RxwT4GBU6 z@=SscTGtaS?zb_+=!I;we+K^c2lMXklaV@t(xf;2uZ}7vgQ%)Oamw$jon` za5B5Qi}BvE2ojs;jm}ni6RJ|!e9!(&M<#4Wdn&-}?kxQI<@#_ob(cgZ4ZxD@$f0+L zwSgKUIx=Zsm*U5IgSPRCEL8?(^@FF1;9S7%KAw4fHUPH)>;SPe2sFv<*Y&fJ@5`Vno(WT6u?@YjpcMIQp)tFge1aE|oTHMGMbF4*^MDv0O z2#-N9=$-*Ks)tfYjQ5GpGbeb$Z^PWNmQoNF`c2ry05sSO!eG?hnttF(%j16qb)U;{B(boIz2S`!R9N*K)pR$_wZYb9X zqyOWn>o@TGW5cv@UyjeNT9kNwII~mM*m~t=oVd`kKV;;R?J-nPdc|_#K4!{+Z&Si@ zUzS78)sFWUH>}&&cWpu2f$2~5vE5%LOWmdh?rhz?z-?5kSm(yT<6S}i1D9Z^W1_XA zG5zv>n5J3Kz?(~9clEWXFA#S2QR3tm>tsR;ya(8TH7=NTB%3aGJ$K+G^Xn1(sy$y1 z`s-j^Asc;NxnJdB(|A|x=90lGaKNf3Lfi5PRoLlGMx#Ek<8*Cy)Us^+k!>1_s%@J_ z|Ha9@v5siUL7{omare@;)Hj^&-smthm)1K}A#?b%3nDR*BE%_9=NNAZxQWPj$Km(y6eqgsP(!7%9oKHB!Cu2`k4 zV-LxM-G51CT1aPOI@QY@KLr`Z*|a2qP;KB#Q=z>lUi@ZNIu%!zvZJ$ws}_d6s2Cx@<*PA!~~W2@Ke1Pn62O|6uNo<;2CssCp)e z3?0>)pMV+#=%H<%gw*eyqHb17HYhufhpH>5eV)>UD~Exxpv zKoM8j6*;WDY%1<-%8n_`%D6Y4=l64iiRBi^$UlpvypxW4z8v5CL^zQR`Ak~CNB#;& z-*e?$bsR8OgK|j6t4CfqX(5?4Uf?SC$TA`0-L$h2CY{7byCPMkuL`Lj3ABvFnz9u3 zXA+1TF4|epd-O0%c{W7z2(k{@uj=x+YeuKCY<~*?0-0n!qwj^M3iG4t z)6{J*3Q2x4AwNzgv2D%Djv=5?xg1{e^t{qR?QenWEI}>jXN#Y%gVeQRk`m8%JykQIUHkBn!E{#cjhRf7O=aw6KD}2)5;)o{ok!ZJ0D^lC|NOEtm1)(UW12% zF3IS==&)0l+LY;nTwv?y?dmMnUOzrBQ{>Tm)g_YCo%lciTJ2vY@4$jGSX&yKi{C3f z*fOEc6mtxx7GCw?OG8H2iF0PVsjH4CiZZ=?C?v4sO9zaEvg%Hj9%{;9h3d$g3!=TG zVI4OvBEfdPRAnqI3FhE|zi$NDueYRA4aWefNfD~!4}N1q6s`LFcMs>sVovwk=&)p2 zv|C@CDnH7Bv_J(HAcBfXY?+aa7UnxQDea%LnF)z(iLkhV-XikQPKW5!Pp1yF8_{bw zs#affX?%Ch8+4k<=LrwE9~daD)eZW>vKb&3V^T4UQzfqq8p)qVU#Uvjabmd(e!z7c zNUWacNw{5xbR>wC6-~KkhZD#@A;;1qbUI#pY52CQK(+PJS!UdF$U**W+^#{{dhih+ z)@kJPTtyy>jM?3_RyrqVF%xItJ+l|7b-^u3=BL{~6A7jmj`+L)CmEdwF#WR|Pynj+ z%2@bX@&q7@&xc%C*_I0XP~Lnh!5Bu{?SaKDaqA&%2X#|WrKSeGxmB2kDF5~&R9r=h z0zWXlvB5;RxrYp2VBjHW)}D>ShL|XfqO;51q+-Kz>~N z$O7~OCf2#3QXx!(i1_D34#Log0d|tnI8#wNH2@q+9VD^d3J3L-dSz?gW(alZU*D1O zvE>@B+0+B`AxHJavyIG(r;{wd{5ygC`2MkB*e$M_uBZ=}6$Q>S1Opy2acz^rrxa;7 zohCyAa5TH2Ob2y!(PqF=`kF6Yf54$aQ!Vm%-w*8X>K*{4GcZe2V{Imq>-LWPy&SR< zdQuaWXNrNVe+3+T+F?;{wv{(8OW|Q4Z@#fS6NbnE`epu8LmhC{OI>+6iRI`c?zyDR zLju7&*51IsTpyayiMD%vY$_q4mmo?3w@3S>$5~u8x9~TJF@ec05vCOGf5tg#p zGRMwYt(&1pt8qP@0e12heqK7jDdd0CShr^3X)UI8^(A)qwHQ@|%>3~#Hx7gN03<2H z*8)7C zYa!;TuhHI8uDZ&8$7My@4^x|`fOV4ZJc;C;8Mo}xDIa6u+sBG+MxgiO9nF>=Yv$tT zZVW%|%6INjfN4uwlJ&mDcNsyx zNsP(|=9yydZ*&8mIKkY(;%hAD-3{%!ccN8Y*M?)T;RIhm;%$&)GjYnCc63m;9L!|! zEBbKk4kN=qaZJVvCS=yT{_-+y92)G~;9ENYC5r=PAFp*ZC_Ss5|NQbej=m1x^_{j0 z=$rE@<-Vne3`9NL&2SR5V*S8HdIR8BQNze7+h|0un);Hq zMUsFzap2hWvP&{X*l%IJ0}hKAZo?yEa)1y@oGutM0)1oWF#_`@O{JNNRuTNFDXCx0 zM%I5SlrwO&=7(fe?kV2^`HY~h;R5}rBgm+IC8O<@#s6rk15elX-MnBzYg%7hB{qc1 z$DM~vUs3 zFnncpg+kb&l>;TR!r$cdSHo%7zeiFfoVbA{QyJhClg(+%W&=nYPv&+pDi{SFQv~fS zgk%RSXI>Sd zDk@sfm{C1bE-YU|e!KxU5{)gdXV9sL8ZxGDLgt#`L$q98Bc~tbkI-5uG)K_|HJzGy z3mI{{+l=V)y61_roZQ(q_?CbR45-d!Vg8R4!sfFw`Wc+A+Mn;w!q3fQDhLh%41nDh z2j)~Xf5|ta3kMge4<uIi1|=?@sG9F2 z6V7O?>8RbS2^{4UT;5CWZ3hnlg`tN5;an1XzdesxIPbRdvnSE=5omgj z(X{6H5GYSYa@C{P6U9Y(*rfR*j9#CjR3kHRo2?`>{dM245q(V$I~p9Js+%#HacomZ zpYOCtRg@ROEe0pnuQ8m0n*Ql?Q17zB3;uIboZKTG8`jJ;&A^RXPoDqUNEbthL^2xQ zcsfm9H;GL-*zRFolb@c3JI#mHDOc(gRZ+^*RL&gmYeAtG;MHx< zQM}m*C6#g~br2BYo4^eRO&!$l1Bq%=d7U=Ki#xy>JH?YoY~A0={>7*TPUgixQ~E1X zcGzuH*?XcEZF%!`DCs6-+`8{0&1K_j9FlKVDY_0KiKeV5;N}W((IhO>QAGO#DV8(9 z4jT(ETj7Ae`OioaDJ%Ljor)}TP%kLC#h~0bYmvG?uRU?34s3HYCb@CIYd7^}#`!^V zG?CZkzFY)eZOowd%~hM~p^Gx5qZ7%smkB*_D(@*N4>D#8rith&1ggBsX@p~O0`TSt zKQn9GJ4$uM5^YH>QkB1|6swN1-exPzQ<3CyxQb57xFzza(Zf>qEfdFRXVbr0b{#vO z1xT0ORkltbThhW+LHW+_Rm!e{myMU~-N(VLMOO4Mow{sH|DuJWx$294#KlHs5Dx{P zP?YXwOXkRgP}CKRJZ|b?v0Sx*K03-|E2oP7;RWh#(Tqdwz@b-vQWO=yWvXi_8xQkn#=lowvPXLbfDab$m9-%~}vObh%DpzXWmT%bTBO zP&`N2f;W0`*1JuWU1M&gu%@|1`F&_mw?YlyS=lna=v zEWlR6aKiB!)DR@6evzW?CnPYfn=IGOU^$nqkqbThGOsK_)#Y7xdJ@%E4fIlxN1r~H zAEh$opiVyA?*tH;&!KiQqKDN~D6BkWLUX3NZ$uXw3BOLq?dFTVP}&bX1?M@^!=rsfy0XkZEC2-)k31s}P z;t?Q<&6NpV+o256puFV_jLZPowMghgpd<%1_uMrfO3@Ej`USw096EsIOw~tEpT)u0 zqtT0uoL3M=bRf)yQcTJ%bN_^*qgj-&X&(9UwPlWzIz=B%JglI5$8Mnga2XHw?I*b+ zIw*hds7#oQL)!D4<4K&d+0mI!G8to$Ot>7U9?0pS2-Uyee{SsgOS*wAfdsoD<5M2g zVb*3Tx)`F_YlVwws87C{t8U4A$dM|WMJUu-t{WTe1RWEhumiN|@Q`4d=1VMdD!A&RuorGCbrz|=mKIiwvI~|2 z^Ui&l5))>&`Q>-M?*Ep=oO@h8`n_zks#l>SyZc0AyD}dIQdwRaQE#`@UXI1j|gW126A_ zuTJJn#+I2!zng^vDc!YEb#gj-{g?9A+}$JwY2C2xz?`R0LF`YAP=z-FWB3~w=K@*X zdR!7$ce0&XBCoO$+!bqpM(3)fhd!J<3}{>lLW7M;jhd}&Se>ahMvLllzApCo!yCMu zhTi&DD(EN(ytBoA4Ec;|P$n)$gSV6#z3{~=P3$HazP->0DwuNJZNF_Hm;&Gx%Y7Tg z=1?RWo`D`msZwL10xn!S@KZYVS_`s(P%sg=I3FrGOmVZuPk5`#1I%1l6DMwEQ>kc6 zYX$7ZI@>X>1s&H6u&2K0;+uBh5OJ#1nQccXbEx{*S)<1rRjK+Ao^SZXJTG(+bh65z z4jG_WaO5SE>ynkCvPfFQVxL z6s|vu%@(M6QE-mxcGN2MS=75@>PEUSLY1n3>Rc}yx1NDYoJ4fkQMkKn7?7BwB`R4K zqcVpNJ5pP?Q|@N!T7yu&6M1lbKHr5Z09!DgkSgId3S!U)^xO_5c#%gn0W?!VVrTS` z+(9iB@0}spg$vAN=ApmA#g=B{-W+rpFt;+m3iZ*GFQZ06M7B)Fs;_l5_w=S@dGKzs zl>a<7>_3J&MGDQUZGgqf7uBE0kIHl^i$x86s~@DgKecc4_u`EZ(*1t)eY)^G5MroB zN=^7YO#-gLa{3KKsE0ZVT;QHT$+W104rK@RD<|C}me00@K zu3LT6q)0~(8_`2aj%p;oCgk&$5z-GL52=#RgYsXo+CpY7m<6%1g+b#vA-%1(sIdP6 za$BznSL%+3a-TWe`SXD2840PK;P@zS0z%^~-0ZtPYT6dE%9fxuQ#!4!)|scl=UMsd z!hI;Xh*c(N!~`nr@ei}{4WT11F2Q#oKVe({)Cd(e3}s$-j&>GhH6E^vLIw)C&{}5R zZNcYF_t%E`Ew#XQeyd-DPWo=jkC~ z!Pridc!1j)V#1Q6cj>|r)W20o?O@ROyNM&Xj|GG4*NnVCj+VIh{0_ubqfg7ewqh5u zsfFWViGnIkJ|Wt;ol*LA6%>B?eVI911DV&nh;&NV4z>nMIoM=_zt%^9*}iE%w;xPp z3pC(sok`dLnDy8KpWl{*Ad!?>=>XaR`k3k4g=hm){M7+KEA_FM9w&Hj?^pR}GZ$Pc z54cLv*%U>JCbp@$W3T*Hk|1`2?Eow8N)8NAs(zM2PB&CePW=C0_KK6`Cp&fcy zj_r=nII_hPLAcEyqAcwVvHa*oNaTT@{4p8xfWlvX>rSRq7Q(@&ojlBuv@=3P0mM4V zZRTm|?JAA?F>_FK3NRwg(Ci0AI(v7Sh^Rcg`_k$xy67mwDC%Z`u^H!<7P6G@9vhlp z)JIkKdSYof8$QB^9mxqO{B+LK$L0`#p@gaNm;D|7ofoeU*(_4Wnag#hx6d`f@!{pg zyN4h}Kv_p4zWlZquaeQ=;^rU7U=E{lC8%saE9IXDjCEVqLpk~4q-;veyuH2so+DY# z7_#57mt{jD_a04N)n-#{nWnTiWVkmaP2sWTg&Ud@4sNpD8Tu=$U@qE_-yWnEy1g1V zUS>{dtv~*9@?>`R?PY}yD;PnqOT3A7Co|ZBBa9YJ?c3Ob_hV1bpd8x7JlT4ECb=t_ zv3VsAOEtVRCrT$$2u`Ap zxgO}OnQs&c{|Nvb>2uUs7tN2itY9fAxXGAeCmFn`XHy${TCsaR((73Ke3?12d$YtP zo!X6eZ-Zsb>VJXn{`qEuMGLo}Q}?1(bXmO@v^&OIzT$K*+a+Z=FF~iWKumy{?-{Z> z?AuGMneRa|{u**NmFuDiXR(YesQT}Vi`a$y_~4oP^D|iCP7XaAqPC!p17EmTKw>e+ zip1;L-5)@e-7-2f;}eo#KH?ka_YmuhP!tT6{KP3Y!#vTc0JzjWVW8<-GE42!9p5un zKgPOaLuTSS4N47OzzTME%e7r^jy%1u)R0Dw#)@;Uy*p8{9q#hhLY=*_VCwLS!9uE0 zLkj(=lQSvbv8TsJ_|i>S_n8Bz`cL@YF8o8oT8q+_(W52%|3%zgak=gJ<6v8z(PY5; zXXzB|46}8qf0#BVPf(4bY1o-DXdAOku(f03HhO1Ll{hTK+i`|3l`$bDIZ?^!rZuwO zzx6(sbCW;_StWRdCTt2%h;)hA83}*TT&{!j9In$G?%d^EM;8ZY7l(zjxpQ5(+}BsD zX8k`CV&gV#-MsJrKOz5>VIE8{W>#1hw>cp(d}ky|OiZ-fx;`F!V@jxcgAhrx-HToVPAZt#n$+Q2!!^Yk`GK|?O17Jb0_F-lkck#q`}d) zi_kXU82IN-(lD^#Q}b?Z(%@WJZgID>?eF@gdb4`XyVMeipB?HkBohX{cRB`3AYZRQ K{<-f3KmH$Sk#vXv literal 0 HcmV?d00001 diff --git a/assets/icons/apple-touch-icon.png b/assets/icons/apple-touch-icon.png new file mode 100644 index 0000000000000000000000000000000000000000..0a048cc9004391214941081a76c9ad02a78ce8fc GIT binary patch literal 2327 zcmZ`(2~<;88h#KE0V$4x$fnF#smlO?utq>pl7O-(V1hst2s}a}Noo?=L=iP21){}; zgvEroKtfQKK#5Z7NW~?AP!cN4pvPK6=GCe-pa(|CJkRT)9nYC_?)~rgfB*L{_q==F zncZ;&I~x}p008WwqaqXFv+Lttih`}p%6G5@EOH`ZBLJYCZ~Gy`681ePQ3*( z;Kk@CN<_R!F6JV7n1|C}%Yip?0JbnTnSeK~A6-*FfM{Tg$Y2slN5Jo7>mMZ21upW3 zvhDXMOu`E(h+sqvTUfl9g5X6GX^oJJ7?}al!1$9Cn1>fq5Ya5w|1*!w0EZ9_?0y1} z5YiN>27iu@Fr^3l*^YA(;t~P=6;#1lbH1edTwzny*W#MWBGLJ;E?=l9HoMq(CLq}E zNO}5w_GzON?AJd(C_emZ?VDEm ziyg$V$^==%$XKe`bDSXMf0!2j6m2Lx1`R@l~7rNksx* zQ$3gY0PtC9aKUexgJ~o>PFhdBCF+I$?g%4_6}-@eSh2Kj@tssXwCVc^f^@wSt$Ecny{x< zwZt{8myS{iC2EDEGOk@`(Y5zShST!N13oda+jk|7YW|^(?D~6vqu0(@{1(WSVR1N- zC#-(OTtj5`a?R-P^X@{8jvd0|ZQ^cy-(+})@WeeCnN1*dYN#`hUrOJjMv`Z=F+|MB z{IB>Dt0ysg*(1S<;h3b(kqwHc|KjGa&>r!}yZhB>ovA0W2d_1=H7}rAfoN#^`+Vn_ z$pUst!)fot>#At3r!ul3Fn=-(Ujmd5krGwb+(0ZT7Bi@uH7x9xd~46FmfC7UXv&al z-VsKf8#|JGQZFskx82$*^4?+8rm=UE%k|B(`m;)h$*t*H`=8WiTwkGd2y+WMvCTiW zf&NZvMy8e?as1Z^NE1xIvE%`_ixGbf1+gJc|6H=u(e2CiBC0RtbT*m4UZKR2ZQow(49&g zUsW)Z&TEp-_9|{{N>=!;8^K_Rd8%R5$e9)zeY2fo#p#2j_?I>piPp zHa!)fsunV?Nj3{|Xk~)RHn6cd{$*TUi=je)PMGD{BomTnoE$KAdFlgW@GU5hO%UBd zsT9aOMg1*IP&#V3T3ZNxUK9;p#GcwO9N&8^mDjC*O{;UJtsjgbZH@ptu)Kw%)Axb^f*(B+c78_C3>|Px)Te z&p00IDbazawL7~)M8pnt z+uU$SO7pmk_=7rp20Q0NSx6O*ONejPYz6JRm(qAU>TjSts7fof?vyM{X*VgYjmh%X z*#i&s=Ta1zhjmitP6^|FXkt)CW3#KTJ!AqL#~;vD#V$Jdx4WK$OXg%{aI&$KL)q{F z_@RA+z0d((Xul*h2J0J)^+j(+`(e>&wg)u(KM8rvtX#10|0kH2B;eo#=Z_r{nII=W z<4`t`pP%oY%b>F<8LVt?=AoRrSD`Mjh*Xr6%t^?|_h21jg1HB?JvfD|Y>!+PhXMcv z_0QifTlyt&!-j|Pk5thw5&+aXTW^Z(%5^Ju)i|J5dPJ7`-_1g;>rC=^^jLd;KsDet gVD+dpO0?4(fSmrqdAmK}0^9GXpZBH-zFFaFJ#{d8T literal 0 HcmV?d00001 diff --git a/assets/icons/browserconfig.xml b/assets/icons/browserconfig.xml new file mode 100644 index 0000000000..b3930d0f04 --- /dev/null +++ b/assets/icons/browserconfig.xml @@ -0,0 +1,9 @@ + + + + + + #da532c + + + diff --git a/assets/icons/favicon-16x16.png b/assets/icons/favicon-16x16.png new file mode 100644 index 0000000000000000000000000000000000000000..246ebd738342ea5e54cda880944ec5315bad3f87 GIT binary patch literal 736 zcmeAS@N?(olHy`uVBq!ia0vp^0wB!63?wyl`GbKJOS+@4BLl<6e(pbstU$g(vPY0F z14ES>14Ba#1H&(%P{RubhEf9thF1v;3|2E37{m+a>rFC0o{dp-A>GuO+j(et_I zyk{OBCGJmc-QAwJz5Sdc4b;MzpcO;4W!g*rW5977~7`<{O()}$c9lAvsHgKi%N5z)O$emAGKZCnwXX QKr0wLUHx3vIVCg!0Dzqsn*aa+ literal 0 HcmV?d00001 diff --git a/assets/icons/favicon-32x32.png b/assets/icons/favicon-32x32.png new file mode 100644 index 0000000000000000000000000000000000000000..72a40d1b1c02c162e7df5aa0d2335a0562fa2377 GIT binary patch literal 985 zcmeAS@N?(olHy`uVBq!ia0vp^3LwnE3?yBabR7dyEa{HEjtmSN`?>!lvVtU&J%W50 z7^>757#dm_7=8hT8eT9klo~KFyh>nTu$sZZAYL$MSD+10;$eVKi0l9V|3gT1H)(~-#)@mtSCrIbe{S0rpb({Rxmi0Up{MJAU6HRW!*ov`K1hqVkq^l>c% z!+(alOIE8wLEQK27*+v|x@eQQ^=wp9#e1-V=;X?e>llE>0u@K4Q~*)wq?x79TpBJ| z11*inEe2Wvw7Tx1^|Q@Dy;eZG9<|hGf&$#bJ4;X3%1XnzJ!^1Nd?Qa#g$x(syO#9tlqPrX7~JBj$L&- z{dO?sGcRH3>xthDG?6jM+uensgH_f8$l)yTh%5$*#e*`sfBUUD6 zA>NOho<0T2v3a^UhFF|#J$2pbkb{83MZq_$g4_q0l$@^INV>ivV)EVp{}t0Gr5bPM z{J8HPv+>r5koj}HD-8bkGlVLMu>^EaWpdoAuwYtOQY3?j_Uc8Z+C~ecUO%{UM}WaK zd-B$;dy|i_tZ=)1dE2>naWVPtxEJshT|6o;J+V3F%cXo4=2r&7wVyp@I45*A{#_~H zAiLeRzg9?Sfq;A~bDQ#imxf@@wsgk_^EcNQa-Q>_bYTCc|5ke#zfay_`d@F)^?)BL za+m%~*k!W4QUBQUU$yEg&j$ZRV*6d+&tm-O*|V7cY{Tcknz~FjF8QP171&khyVNsz z*>}dVEvpfVWeT?M>}%`tf5g7ZuIs+NW!!tGxV@7~fPti1;u=wsl30>zm0Xkxq!^40 z3@vmGOmz*6LJW+p3@xk-jkOJotPBjCPJBo~(U6;;l9^VCTZ8dbj~hS@k{}y`^V3So z6N^$A%FE03GV`*FlM@S4_413-XTP(N0xAlx3W+EQN-S3>D9TUE%t=)!sVqoU$Sf#H zW?-n8^Y{}FM`4(T#wq{PXFQ(m_pwD+_y17GV}vaA`0(oWiWUIYi;~jVmXP loH-(Mg#C1b#{w@shF9W(C7+y3rvj~D@O1TaS?83{1OR(=hlv0H literal 0 HcmV?d00001 diff --git a/assets/icons/favicon.ico b/assets/icons/favicon.ico new file mode 100644 index 0000000000000000000000000000000000000000..ac278087f4c38139b33db4edbfbf1f46cf9f8a58 GIT binary patch literal 15086 zcmdU$TWr%-7{|Xf740U*DxP>iBa@i4N5r-CMnH&5HEmBwv>hU}orX3ckbt!X+IV|_ z?PX&;lsn}%h6+XFQg)XDj17%j+6nDp($ooP_CyofN<2);{@<~WP<4ghf0v^U9wB-B!?XN^UWbEyVD%<;LkM&oxQrheOYCnG9p>+Y^HX|li!@f;w*j1 zHM`8oE(Z_zo#vpkSM)12PU>BsdvdPt+5?E z<~QfC1m}a8Cs5hL!;&FiD{~kJev!kj#`@*r8j2OPs=(_RyUd+)7$^RC+otuR-Z_Wr zK4m`o%`>U%ne7kn8wdV`&fYV$oVbif4q)fF9`l>nTh4*NjqrlIJaK) zkUzzKVJN6_>-X=Y#QU(QIfRFD?n5c|8Q{O;5r5*N=7w_S6P%*Xb$0m-l79{+cJT99 zk#9+{Um99ws&~mQ?I`gvSStTe7NQNDw}S<{2mEICk!;UP_x@;aD6Ki=00J>nkW3**PDF{Lfq7TVKKP3$Zw5cgU}^i$02bKEChsx>P*a zJ%{VY4Z8z=oqfFSfyKC)>hIiVZZntDlA-@hdiD(UKPA|0_@B2mHB@q6oUDDu*tbmm zXLthGe=+j7{cPYbH2ZY0=EcsrYW!1@UE?2aX{@U%V1M_d-eo_V0QOr_+Y4LZdiRu_ z^N(->exd=kB}CiU&L9#Gv$KitCpNH4e2GKE!F~nr6-Cs-pJ_n2i(|yG2q1j15)Ufa z*@DAZuMI;EMnQ%!>dKyx62#HdHd8 zZsR!d{p@m@#`_UxI$Ok@#TGjJVifC!V8IcIz#{fP3M{m?!?3pCUY1P$$J^m#@&(%g z^}Q-zM18l)uMpuQyZi8w-Boqc)Jan(OB2Io+Wc%`d{3w_3^MQ2^7+niolTB& zTWH#eQ&KxEe>vYYKJ}p0dE%r|+ftu7yk(GicbTyTn zPCw>_-=?l)DYU+`Vo2+MvJV(-Zfzm7ai4xdJcmV<4#99K{=JzYtG@esQ1gz4yVB;) zq8;s8J^Wx~aHQ{?LDu=nG;R6rLBFzxx*xv;{U0TRWBu$5ns)eSVUcF0CGZcC9~_LCw2Ad?vG|`u<1in2t8OI{0!<`WnOG13UfV z9E&PvQ*q5Y_S-yHlZXC6TG#ET?ruNkCp&Y|uf+UFPWsLDs&-HO1p3g4oEV_}*YzzW zZuRjTeMsc3YHM?yi7ru=*16Hz)xWN7eqeC9ok=@G{zs{M9p5_~LwS))!F4A5 zsC(TsXk0VqYyNDJztGn29kgqwtMLu(?L^z0e@k=yG0xi??TuH>xms<@{3k*?m4Dsw zLgy{(qP598ZH(tvWL&4#tGsj3W<~|$OOU82KvazBfznd^%NPFDD^P@~15ATN2-6r8 zEDBMecpjCN&Z5$?=~Nt;MnyqCW+r@McA^M}7Q>|!u4M=jK&T)>M*I<9GN}}ipNa`z zV_k-I0P7&u3fBDpWIQbaebVPC0AOCue7<27c%L|}SHp2nHeddFRclj2EQc7v7vpYB zJx>~9XTR968nK@m;@kbE^Ynwu=T@^Xis3rzD8|!0R}S)T$ig?>pWn-9h<&wx!x}IQ zT5t^RyR~&q3rR)#V#rQ+${+m{?Z|?2$!J26Mj(fcu zkFsyNe?#ougCEx7o?EdiHPJn<<9dHY`lkF{eKYgj>zfW6eN}&FzV~}Whs?gb z&CJf=%qbkcf~F(k_Ea!GJuJr>W)v5;2nS zm`!+yfCw?7K&)6$Tie>wDOgZ!A&3rZ?W#PM=q^Hl;$y7rhm4l}V`t9&o!|MLbAI19 zckbLGab(yE$5oC1fE7XkB7xbs@DOnj`>S1xVZtZ#BlrNc8Ju1uIKY}N6G$QeP^|+% zqXpnOlr%N~K4Sy$C>{V#H305eb>BpB0l;L7w@FbrkZ%pnAK-v_5P#`LtV{t>V-1D~ z^;ev`!23B1eBe+0pp~N;;HdjIL4Cdf%)eT2|3z^rhvJ(Onk<%ZY<_-zy6|ZzeChk;lE`RaIDt{e}3z zyy}C;@}uKdYlxUbhI*``3S&G_&``Gju&Mkr?a2!H5p(6f!c#|eIaQ6g?5v}W*q5oN zamKQ&v~qmK*~~qamNR=>GSYF))lD@SwN2@nXX=_yoZgFV#2jm>#_y@AwWJ-ddwDkX zMCb#DdUylOuJABK6?E%J8Y~EMVFXGTcEI9XNo%fXufZ=XT!`?ciaS3KJ=^ELaV6ot zyHD627K<)rv2-~KU$lf(fc=;YNXQiRsKuN1G~!9eR}+ud{UiPFPkJ)uX14DxKTuzD zV^o3ppk21MPZpfuE8AMteqDpG1If-2_-{Eb6IGhq(ZzE;=og#W)@3O%<_Ph-=I>m^ z66@t{(t>4cExbzF1_eXXg{{BDey>fO=2;t>+a z#EenX3Cy=9yh=PwR~YWiZq|$V%IMK$Nfaedh;E>ikp_!WI`Ea@ql6?^2VSiFzKJWs zN+{UWsOui(njHO)CTBCTIX}ud5z(PFmr#+A7dtEW?AfqSL%GWLK`xE=yx6i$3sS97 zE#pHel(!OilCm*>^N6c)oBYQ)1PwAGgVSAzz(@`0{hgbfamPe-8ZP#rd2xI&b|g|H z))KOjrn~ha_A=ru-ZATVd&DIhUNdcICibojIUmkTAYZ!>(S zI5?NZi!zXZHikHhC!R@t+H4nc?u`HR5#c0P5H<1j$5VWPft<&m5%W_Fl4$?3n;+qS z`$=7D3oq6!V<;Ks;0)4oWOk)>XUF*20un=wWt`W6U5YD=4g$#%@@X_TG%!Q`y+=K4MA5IM>MpNeQ^BAIVirvJ!*UJr^?M%7oVUOqSGB7P6A5wG0 zSOb+m=tf}L15r;AMXG*$jr*myt>{p>veeep;I!HMWLQg4`)$7`&rFT9M&k3C`$+#O z0(1KC?Ey8LVY?+mIwbsel*0^C%EVVWzfHD;M3HAFii%7J3=*}k6}P@wCW^to&E=Cv zr?iOistn2R;^ohc*h}aY-M$4oXbr?2^}0Mosm*UqbFxA5?K_MfTXr$Mshe5wIZa2L zR+ZW&*9p`wAFdvx@-sx+FFHK`Yf}>w+dJcJ2y1EEI{WGJ>yK0Q@kH8o{Nbq>#>&EO zeLS7UT2Z2uq@dn1b-AZ2gh z_y=+PH~O*zIBd4(%Bykzvyh&dn7Ui}{};q)-Y{JFn@SoZmn0mZXXRw>PTiYCmn*Z9 z=&4z9832m9k!fdQ_9x!n*G0WIgkutb^KyD$=H%w(7G6QYxzQ0#U}qxE>w=WtJ2cqS jb)(Cpi_ohPn6|zT9=Vg{(_1zkg+~A(8i}-Si7)ss0TkbW86FiO27)+ZO?Qmr*ZDD>?>qP0eb!lfopsOM z=j@M+;5a#;4hVucg@p!1BZv*&^4Q}5S(`fj2)y3gwlaJrg4D|$UnNe1u{$?3IvhcS zix5Qo1%kW;NIZlf8Ds=`l7JwLZxF;S?bzigCJ611ToV&)A>5*ibWE|1iI|auf3%5p z{u{ViA{_&IXt}=xSU|16Naruo`ir$p%do>Anq?M19TS2#i45R~J3!4s%k5+UXg-4& zYmjGe+JF+VYK~REMF1D;{6IWMO9yeQh`8MnfQXe0v9OH=t_;;+HSis7^_kycA-`+6 zoir;h)-tS%zV+75%GbX2X|bpC&(m7;Au(TPQGgggafijT_|3QHcf952bVyo3Zg21u1cOY=AOe+pHAh3dFvpL#zD*=8+z92ec9pa%cwaNOI$Jct|!t9d% z;zh#41CKvC^kL4yL6SU+nESr`bg4t%0@C2950?MI{k(f<{@q@8(O>RR=5>!!(tP;y z=6Clj9$J=;t2EsHco)^}SHTirLdK(KPj=t(T%PIY>XmAI=>FudUcS(h7%GyVP4gU4YO257@DZrdcW>HVR`pOx`VvxWzHtnG}%l-w>?WcoPo9I z?+pQE1OAwuu(1p`P!ONmYu{JT?uFnniMd-n5m@J!p1{-&-^6TKwF+B~y?mGjsVR_J z$b-~a*$e1*%kI`*(nwj%onywpIz#U_BbVuCz=Rto$=UQWLMA3$TvI^&LQ_)v=70TKi`FL(Rs8W-k_fKlOFHpY!Y(t6XWUMU%i6C!kfW1GE!#C!C)d&Mgjo> zMuCYunuGj`;VzM9Xv6~;k13}{e_1hpeXrZq`;(EchnnP{E3?bHr})h*S5zJl`#|)x z%vRD>(G@vKZe7=VFgwP#8uA`tv*niyFFS95$!nZ-?1v)HwFOPx6*Y;^1M7~Yy~uV! z<=y$$e6z~Ci)gt_6Z+&)VzvV|N^q2Z^mnv{Yj&Y+Vzr?{aJN{Zkc6{`3*x;8(u`+! zoX(N_wyt;RIf+_Eef`^c_(eT?D_ScyR*XO-;Xd!`bai%Z zteXUT%1-NId4MfJ80`$f$0@^1xe$b%l*DkW2|oCKk}@<~$9V&Q>xY*qbOVaGusc4I!{tN8hQDo!mJkK*u79L=dC!+nkh=SYkNdS=yl&gzMQgA&0Sj zYR*!$MX&FCh%QdA&U<|F_&7P)qq(m}_xwdyTG@7l&86E@DZdId8eSse3Lek5G$>u-JasbunwS$`KB%s)W~$c>2~wEx&gwcqT&D! zBK4A|jvvX*T$CZ3FyMHC95@TmxRN(VJ#P|b>DXTQo?v|d(@?uII} zlU+w+;Z*IEO?+p&;|`nzfBN#Dc9aklKk#RquvD#~cU~x@Ts=BllYlOQlqDLq_uk}r zKuy6MrOLg$q`P$};EtN>=mvN%;~Y2Mk3=^Tt_}7)mftk)3esw!-W9YHyb{8o`ewax zn~SAT8_V>$p3+kgloC&bG~pWKHM7>kN*OzkVTXLT!)Z#9jf*(9Pg|}VTV4z-xN!mX z6Iday-nT?UDypMwl`GAv?&fnM&hS6~&pr32w_u#;acKD`OOYpTvjk(Se7}Yzkg(v0pxRXl GdwvHZ(=_7% literal 0 HcmV?d00001 diff --git a/assets/icons/mstile-310x150.png b/assets/icons/mstile-310x150.png new file mode 100644 index 0000000000000000000000000000000000000000..e3f88b827f18860878c91454a2f554742edd4b74 GIT binary patch literal 2542 zcma)6c~nzZ9)8HU;xeKoE{ISTQON>=EWs+9f{`tz1=AQdp|VsVgb@-*a$Lt!6+~au z+FC6U*`@F-5mKfjSZGj_kPt=O6B|LGMivn?bMK4easHTd%(*A;cfa3vzx(~}b~q|x z)0|mLW+4bNCoD9Wjv!M=2x2jJh9y8wD>62M&)>cZ2oFGzx?@(82~$DeJ}HzQjvzc2 z1QG2=kk=uSWX=p~F#I7$K0L@f9llMM{6fgv4W=A|;iX zlq*#Ffq&5QZ+!+q1y!h|3Kdk5!XI{3RM21+fJ%Q5-~;^tN2CI3ke1)&2S8H=@}e5~ z3vW;B5woVT>Ky`bk-}1YB z%(zJ5XP)$(x0~w(ig!MtJteh30rkN^ff6c!7=R)b^en<_7pUIx3sk;>|JG>M1e_1W zL2S1AAqY6;_8tTrGt-O%8z3-)CXD;jJkm--7PO-F}udkO@Ajq_wu;2hjZqGn( zOi6F>!h;FlWpF&)vN{&q%w9xE{mo@lN%+lp)!v!coiLMcfA_Z=e~LDA(fc!7Cs@zb zH`921mAs+neaomo{NsKe)X3K>dOFHpIY!)gyfbps{_o3DM=r>0-PJs$-Q4qCZ*F}i zJFEPOFfj7>9-P6Hi|b#Han?$=e803*oNc_;iW63k za0U%{v~>W|&Zd!j`W0yBRBDfIbnibv3O#YjMevGStU-dz-Ods4vR*PaT2vK2~Rc zXUKgThCY5Pp2MlDp%PNbm6+!kTp$Z+JMXlXGp1^Z^d5$QgEW*^UMp$5m9&qw#p(~| zX7M)S7$bcp?@ka2J)pPlp=A?CVAWCaqy$-mhJF_oap0-7ipB>v?D*|%RS#KL`9O5{ z6Vrq3_=f&F`&pl)3B@Z7Eh=mp5}1l#vjfw%;aMkX!-(}4v@DaH&2bMqLCYrBGwlo& z5*1YL;H36BH=}yENTH`_1?1yQln1uWA(fOP>rBt1T!LlEbcsiO#2R)fb^=f4ku+=_ z<_6>Q|74;3!{rjg)a$J}`k-?S;1h0JpOjw^-)0)xE;h2hVcQwW6FN*$7*;Ips0qs{zyK~Fu7p!-|PIa}Q z2KHL)m!PURVx<4GxC^{H>L2Dx1=#cTMPo*Fm)h8(s72ih2a>n)eG-E;#&1oA!^}i} zUboQT3(jTVmoyeA{0A+Ny^pmHd(`S1LH#4OVC$l-q_K|G`UBgDWRy%lHDaX4lF1W? zBGrMU?%C0WRbo0(mw4nd8Z&u_U9JA~nS=!ftl2^=WY684=0HfFR^i+r)=mb!WVW}R zIiEJOUqXk3SfYcBkq+_)D8XQ~D>j_El!r_knJu$IzulCAf&RuQIo|Joc=Fi-I2*#*+DN!^3Z z(X=2a)WDP%J7GKS-134qNU;-B&* zZTz0;_*L{I{#0l=8C6XDSyHrP4E&7OfeSkR#8rBG4Ub5}-z4g2nQ&PxSQjvDX%wv- zzGbRQ$x7g|bx{*~fw0I^Kpalg7Pnllb(X)qNcgz7{o`1sIi@L+qfQnnGji*|2xo3c zEO$o&H`y`qC|NVezZWhUFFW^$7dB=_tSuIGkUqkEt})Q-BrH2D MBqF#bFn;fU0P%sYHvj+t literal 0 HcmV?d00001 diff --git a/assets/icons/mstile-310x310.png b/assets/icons/mstile-310x310.png new file mode 100644 index 0000000000000000000000000000000000000000..f0702f48c81fff349e9034ba23dc00ad9d402417 GIT binary patch literal 4166 zcmcguYgAKL77jj^RTL^XppLanB`VdMAl3&ys!&iMJOhGULQo+pi3%p5kcc3@MsXAZ z+-n3u9^w74NW_Q{t4?dYAc6r)Mbt__kcS2mgsRLrH(jYSvu3UNRaUrnpMAc)_qX>x z_ndRe+jH}bX>+GhD3lqlE>27eWdaTUe>M?lD$@l0;5BKNgNFl!^8GpE_uD6fu~n!G z(}O}0E~HQrj!`IMK$Y-{LW#DeP;kQjz z4`lE}Lt}uTe;Skq7|`pLdaz#q-%0~U574`PQ%?Dhp8=-Ve+mP#L8%w?Q4Ago0H8Mj zfB=RDRt6bp^fItA{D4v~gDJfLG{A%YsdokRdYIv9(CeoRL%pE^ruV5I>Zbr+4+csg z7$O3sfq+2|G5P95CRB#&G`8ErcK{%0lm+QVtV>g!ar&q&p9M- z=YH6j!V_=UGrTQz@3(3D)`z4=3>mG%BE3T=;OyD)35z4oonQ54f3hT)pK?JU&WK87 zWk#nRxR`DfbP#*LdDVP5W)ySJ6jz$A8}N%A`t7{$+WUVIHqVl1K4*&75KR}xd=8ms z*gvd~^PZXc_VDV)1~0RV@efvc?#!An`ey1%kL)9t+*c?5~Cb1e6r+wr{Rt|#&* zp0snBy&Sg#bd7c}HaivGs#yX*fhke09?nyKojhTp+2`WwQ(#F?w|8}N@QeASzg?Y8 z-8|>Si(51!i-W+>?PTM*?ZJtRZG|I)Veb&T=rNbNmMvPTH6e&p;i1uJV_^G!=_Kt#AgQB)V} zRod_T;h!131^AQHq@(G&+>gKPEx%%^tr_SvQDzTZ`;o0OUv0mc-a9pOdWNEi-=xjW zx~1Gmj@N7Xg`LU%ilRl4c2VubMWuArL~`&jNjPEAomTchRRJ`g^U8Vsk<=r9h&kiz z0XN#y*`z+Fkv)LTW7b$|CwZQTQ?v)S66@#c{)jRRMcZC=ma;K`bgYl@ZkSK!r~LI3 z*9F7;LFW;Oekh`kxSA9Ma)bW{7dpGHrL8Ox8buwS4>3TvfEzGDvbW_F(=A>Rat zBxzR9xq_bz&e6QtoOv_U6L!K$(AFolTrTv<98nOI5^sKlrYrWvb?M$*-cv1nL*C`pV;P^xK_4Uq8gpcMfLss7dDcq>hZ_oXRtOyg77C`T=qzIMi@IyJ}bZq#}xCZUT!>PKeRWKSHA}K z4|XDC-I&(+i+0~s(>PR$W@WA8uo!F@HBBk?pr7O^d!dP=y!sW#4Y7x5GQY;h6z-+e zJlN{fYGy57EW0ZLt;=W8qD2xmQH1YGW-Oa5C~jlqW4lRTuqC@JO4WhN?)fFupCLCiZ;%iIScA&oq(pIV3c z&>I)xZC`g*wGjd*nLC-@TzT4SwOrZl#FLPLw(xCQh<3C9eweNoS@(zS>M&O_k_||F zNc>ahFf$jkAvH_zQAJuY#}Sh9BRKo$Qm%bFWUJ*%9y8?VCdImJR@D}mj^!k7>~>AY z5Z7J>0V@Q`LFpc33S7haT$)^wR>6sfZd47_N?arBBe~s|gJ5}B92sma9z&1jwmpL8 zErL@zW-0cRoY;Uju-Von92JqIq?S3*QrH!4A31I40WyUoR>26f2Kxd+o2~I;g{p!h zf|06~9F(r*wUI0BAACtOBMH4qnv}9kM))lZ&+!}nND#>|kakCoFEl+YDZ=)Xwgh0? z&z(cU@33@Qjpl@Gk1nwX?W(H9ugV@Wt`^9r2Sf}?qmf~8>0a6sQFw^4B8;0!TxHJ! z(^;+ZGomJyBR%j!H|WL^C!jm4lkd^-Q38EMJ!*wNRaBQBXa71&-q#DAm@QNS+Wov7 ze6a`ZiO>g_I^?o`RP5&F;Ip^T?zB|855%MwVaAs1@~m5@mg0|Dsq;0c4^k;ofP$5v z9gz)P)C=qm7i8vBRc_C5bjMh+bCa=bQnVlAH+B)Vq!2|%9FgrBv?DF^QI#e4l<#9r z7w?(4eaN5NBe{;fKKrZynDMJC)cqNMxWYT2T(>ejDwG zeLDVe)ek=^SYC+adXaQLJscTif<~VME8<3NFtQ5v!WEeza^=M~&aiATU)>|cb}G(r z|Ar^*Eq^n9FZk667sQ;FTUgnYkY@0cj~ZNIq<^bO4^BlTv%%l#9VX=mgZZSY)j{GhDobNW&@{u5Objt7V5N0 zqg^SR*GDY{PA|icuVFHbREg?z;y{qd`If3eydCu8RylT25eD5IkoCO+aU)39r&~1* z7P3A4oK1lFwymIr&)hm*bOpjFp-3M4=K4b5`MfW2@TO=ib#AL&uey3SfIbf-ve>sF zDjZp>r&%GJ_ho!U5Pc5R?nQz`B*XhEO`HSxew8JF?it=3t>$PMq$3C0V1Ssx8RCuR zRA8y>!)Z4>$b%zHrFnUnYtsxjm@Ziwyb73)pwr;Vb1DuQf_wJeI;;(DBvlEZpzn{d zxPgwKaqt|TDXV`CciN4}hW;8XkOU>8p2E>U4V%2G1iB&MMD==ZU5RCn1b`-oBr{@( zVrnfs7cBf3`{2H^v>2<0XIh{i5=*)$L#v=sXCzV=RYEO<*j(9rw~OCZ;~}XGhon+< zKK{%)BIYuj!2%f9NN-yi)#P|9gVYy1)&ymvJ4lE1`eUQ&AzTrTG-_X&`e27_5)2ad z{qLuRx|M(E{cqtU{yEIyJ55DRGQnb0aCVR^uVebjK3Ihm*3Q5f#FzBYBXcKjPz~tE zG?ix8IBG&(Tr@m;@@!dBr1pjm%5pIBR#a7p@mdz(eQLTgXgr;zDa*saEfSPhjOyUl zsziU^?@Nn02chBnLaYv{1M3Nba`ijBQi^^&JXUED1ZoSA4Yrr>iU$S(Lcgt1%a!UB-PT0f+ rSNyDqpH=tn*593XcM6f9w30rEy%54pVk@_H?Rn+?Mz+rRJP( literal 0 HcmV?d00001 diff --git a/assets/icons/mstile-70x70.png b/assets/icons/mstile-70x70.png new file mode 100644 index 0000000000000000000000000000000000000000..8b7596f428df3507300793440458ec4f59ac0055 GIT binary patch literal 1563 zcmZ`&X;4#F6uvJT0fHs4KzVm(O-1lbQH!)G$ ztSp=?0036(@X$CI(S?VIgR0T-lXCMn}t`fYh_z3P7C8TD(`zVJvlt3?02S|DYAU~O(38%pc z5HwwN(VNzpd?Gi;bg@Mc(qL}#@GbVHW-Yc%$-ga85--P;FY-+ZTnceG7M4b%QNJwB z4}LzrFfM8buQ*-{6FoJr*#{i@dvcRTxR zI+i}U*KTe9xb1eStZB%ZIxtMSYO8u=y`=S_%SdO7)dQR64$^a1m5e&**#2~MxwX@? zwq?$(m!#oFxDVMMu`Tpq$6?(HSeOafkzr;p@ffV#l7qk0?gId8!474`i=Jt_Qh5Dz zO8yInt8U9wM^s!@z6zJ+vXSb0lWjCIwd|r*ZRWXc@9MVvdRs~JHl4_!vOdQ~ zzeDHF9iMP)NR(O$(Qh;GnTj7D#o{wTffoQ7cp|L~V5TpMFeHulU@-p7DkhT4Kje&% z&a6}*xyh6~EbY7k4|`GgGj8eF>DZ%r?r6bzTg%Up-!TV3ox+8N3ut+(9q#j<2Gb)v zy_ZTqS%SG>aUWd9Fi@Mxp#m+lKtWbmyLtw>TyMP?>AL#4>(O!X!Q45@|bv!4ROrA zaQ+&NqUe5aUo6Wv9AVL!L?4BCb$vK~%tkm{gu$S(>Hz`K0}xn}efAf?-1Z30gcrsM z$bOE$e?J%hW&pE-8G`CgV?5CniupJuL9^==&{`rcOk$-{91pObN-*^`#+imsUryc( z=Kh#@Nf_>~F1m>(*SvZ#95^hK-N3EsJWEbQbs5a3P2$%+KIlAMK0eBu#2l^zh$^3pJe2Q;$jSiOx-ajW=#Q+FC(bm4B-=u8BtiZVIym#6s!sCF}%l=L<7+m zlk4^6JLGy5vgiGmtUk&0$DqNmM_O$R)`uWsagDss8mF6$lx8wWoQVl(nbEft88n>I zT=7&J+`!FI3UwX<<+m-$K1>u7P`zW0J1#|1)i+Dfh*wiL>BWd(^o7`sN;O;u_ddkj znF}gK>h&d>kSJ{Wl%?{axg8qal&o1YJrSXdqbu&M#mT@?30wT8nF%L=(ksa|Pm-uWm?d|2dKdMilqip*1u8 z01y@bHbWw2?DX(xkM8JX zzlsA`cS|3hCE1-EafyN@(?Zb=Dn8b|CZ5(Y_@uSDv)Q@XtOE^~f93 + + + +Created by potrace 1.11, written by Peter Selinger 2001-2013 + + + + + + + + + + + diff --git a/assets/images/loading.svg b/assets/images/loading.svg new file mode 100644 index 0000000000..45495256bb --- /dev/null +++ b/assets/images/loading.svg @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/assets/images/smiley-cyrus.jpg b/assets/images/smiley-cyrus.jpg new file mode 100644 index 0000000000000000000000000000000000000000..784a6b9f904a72c7f9712f84748c5f0023e6e9ff GIT binary patch literal 1343 zcma))dpOez7{`A<+gK)<%XnPoG|r>smM$zIwOppBQ#&2E>Xe8_%xx}}Tx#W36tc`U zXBu^Qa>+KficC~vXfaGIHk??9<$88>{^_stJm>R#|9GG0eV_09$M>rcD#ic}ysL*R z0B&LdS^$7z7&rnzl$5?}6X>R3a2N~+@QQM}ghtk&5)Yj2fv;YV=kOHKDAQDh;0Yd-;Ko|%DKTrmtFcmmNX>+?*0|23* z5)`Tof?NK*00E`Vx5`MB?YmvznkW6Ww4<))loL#JFt`iRq#L>QiXj00-Od>(#{6Hb zo0lX^|9jqAwp1^ zMPEwg1=(%HnU5fKq-KbF{GpYwiwLX%q&oJ3EplnNawK?WuFUV(lrAgE8+eO|!bKli z-J7?1(z~t~zg!VO%TEh_EvGb9_Kq^t-9Bb4gZ3!3BgL#<7HuCcEWkF&R;i!qFFVP$S>DpopmIi#jmIwq@QCCtinwU3!-z1^NrantdY9V_fi7yo{a zFsJSu{Aulpla0k4NAgNOMAiFbQ7VIdK3Rd?=wi0~FE;*6cAnU^AZ=AJ$4YUoFp&m1 z!~)^dhKX0IUORKM)7X)RKQpG4;AQ_-HA%~t?0rjcEqN$7$R(InDmfyujCQR+sg{ z-bw`t;S;*jC$3T!N6ReVW(0p7SaJ>O_cp^eTz$vs^I){y69NvKl}xa>`lDu+REwD!w5YMl7|EMp{fqi+4I_%7*EFcOn}PG4SmJYOJ>Cr!pwBo=;5&Toi`NKJIS zPI16yR0#GLx*+lVG#_Jm>(8SLrU^TZk(Zxe7uPsHAW=!?dQiP)u2SzXpSfdrZ4nmj zRsDhLNGvY1q?C>OJyX z&7On^33;j6%-&*v;h0bQM_A785qB|H2M1)Tg;M1& literal 0 HcmV?d00001 diff --git a/assets/site.webmanifest b/assets/site.webmanifest new file mode 100644 index 0000000000..b20abb7cbb --- /dev/null +++ b/assets/site.webmanifest @@ -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" +} diff --git a/elm-package.json b/elm-package.json deleted file mode 100644 index 2a973612d9..0000000000 --- a/elm-package.json +++ /dev/null @@ -1,26 +0,0 @@ -{ - "version": "1.0.0", - "summary": "helpful summary of your project, less than 80 characters", - "repository": "https://github.com/user/project.git", - "license": "BSD3", - "source-directories": [ - "src" - ], - "exposed-modules": [], - "dependencies": { - "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", - "elm-community/json-extra": "2.1.0 <= v < 3.0.0", - "elm-lang/core": "5.1.1 <= v < 6.0.0", - "elm-lang/dom": "1.1.1 <= v < 2.0.0", - "elm-lang/html": "2.0.0 <= v < 3.0.0", - "elm-lang/http": "1.0.0 <= v < 2.0.0", - "elm-lang/navigation": "2.1.0 <= v < 3.0.0", - "evancz/elm-markdown": "3.0.2 <= v < 4.0.0", - "evancz/url-parser": "2.0.1 <= v < 3.0.0", - "lukewestby/elm-http-builder": "5.1.0 <= v < 6.0.0", - "mgold/elm-date-format": "1.3.0 <= v < 2.0.0", - "rtfeldman/elm-validate": "2.0.0 <= v < 3.0.0", - "rtfeldman/selectlist": "1.0.0 <= v < 2.0.0" - }, - "elm-version": "0.18.0 <= v < 0.19.0" -} diff --git a/elm.json b/elm.json new file mode 100644 index 0000000000..06273239cb --- /dev/null +++ b/elm.json @@ -0,0 +1,33 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.0", + "dependencies": { + "direct": { + "NoRedInk/elm-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", + "rtfeldman/elm-iso8601-date-strings": "1.0.0" + }, + "indirect": { + "elm/parser": "1.0.0", + "elm/virtual-dom": "1.0.0" + } + }, + "test-dependencies": { + "direct": { + "elm-explorations/test": "1.0.0" + }, + "indirect": { + "elm/random": "1.0.0" + } + } +} diff --git a/index.html b/index.html index 80354c79e0..a8be6e5343 100644 --- a/index.html +++ b/index.html @@ -3,29 +3,45 @@ Conduit + + + + + + + + + - - - + diff --git a/src/Api.elm b/src/Api.elm new file mode 100644 index 0000000000..484b2559c9 --- /dev/null +++ b/src/Api.elm @@ -0,0 +1,300 @@ +port module Api exposing (Cred, addServerError, application, decodeErrors, delete, get, login, logout, post, put, register, settings, storeCredWith, username, viewerChanges) + +{-| This module is responsible for communicating to the Conduit API. + +It exposes an opaque Endpoint type which is guaranteed to point to the correct URL. + +-} + +import Api.Endpoint as Endpoint exposing (Endpoint) +import Avatar exposing (Avatar) +import Browser +import Browser.Navigation as Nav +import Http exposing (Body, Expect) +import Json.Decode as Decode exposing (Decoder, Value, decodeString, field, string) +import Json.Decode.Pipeline as Pipeline exposing (optional, required) +import Json.Encode as Encode +import Url exposing (Url) +import Username exposing (Username) + + + +-- CRED + + +{-| 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! + +-} +type Cred + = Cred Username String + + +username : Cred -> Username +username (Cred val _) = + val + + +credHeader : Cred -> Http.Header +credHeader (Cred _ str) = + Http.header "authorization" ("Token " ++ str) + + +{-| It's important that this is never exposed! + +We epxose `login` and `application` instead, so we can be certain that if anyone +ever has access to a `Cred` value, it came from either the login API endpoint +or was passed in via flags. + +-} +credDecoder : Decoder Cred +credDecoder = + Decode.succeed Cred + |> required "username" Username.decoder + |> required "token" Decode.string + + + +-- PERSISTENCE + + +decode : Decoder (Cred -> viewer) -> Value -> Result Decode.Error viewer +decode decoder value = + -- It's stored in localStorage as a JSON String; + -- first decode the Value as a String, then + -- decode that String as JSON. + Decode.decodeValue Decode.string value + |> Result.andThen (\str -> Decode.decodeString (Decode.field "user" (decoderFromCred decoder)) str) + + +port onStoreChange : (Value -> msg) -> Sub msg + + +viewerChanges : (Maybe viewer -> msg) -> Decoder (Cred -> viewer) -> Sub msg +viewerChanges toMsg decoder = + onStoreChange (\value -> toMsg (decodeFromChange decoder value)) + + +decodeFromChange : Decoder (Cred -> viewer) -> Value -> Maybe viewer +decodeFromChange viewerDecoder val = + -- It's stored in localStorage as a JSON String; + -- first decode the Value as a String, then + -- decode that String as JSON. + Decode.decodeValue (storageDecoder viewerDecoder) val + |> Result.toMaybe + + +storeCredWith : Cred -> Avatar -> Cmd msg +storeCredWith (Cred uname token) avatar = + let + json = + Encode.object + [ ( "user" + , Encode.object + [ ( "username", Username.encode uname ) + , ( "token", Encode.string token ) + , ( "image", Avatar.encode avatar ) + ] + ) + ] + in + storeCache (Just json) + + +logout : Cmd msg +logout = + storeCache Nothing + + +port storeCache : Maybe Value -> Cmd msg + + + +-- SERIALIZATION +-- APPLICATION + + +application : + Decoder (Cred -> viewer) + -> + { init : Maybe viewer -> Url -> Nav.Key -> ( model, Cmd msg ) + , onUrlChange : Url -> msg + , onUrlRequest : Browser.UrlRequest -> msg + , subscriptions : model -> Sub msg + , update : msg -> model -> ( model, Cmd msg ) + , view : model -> Browser.Document msg + } + -> Program Value model msg +application viewerDecoder config = + let + init flags url navKey = + let + maybeViewer = + Decode.decodeValue Decode.string flags + |> Result.andThen (Decode.decodeString (storageDecoder viewerDecoder)) + |> Result.toMaybe + in + config.init maybeViewer url navKey + in + Browser.application + { init = init + , onUrlChange = config.onUrlChange + , onUrlRequest = config.onUrlRequest + , subscriptions = config.subscriptions + , update = config.update + , view = config.view + } + + +storageDecoder : Decoder (Cred -> viewer) -> Decoder viewer +storageDecoder viewerDecoder = + Decode.field "user" (decoderFromCred viewerDecoder) + + + +-- HTTP + + +get : Endpoint -> Maybe Cred -> Decoder a -> Http.Request a +get url maybeCred decoder = + Endpoint.request + { method = "GET" + , url = url + , expect = Http.expectJson decoder + , headers = + case maybeCred of + Just cred -> + [ credHeader cred ] + + Nothing -> + [] + , body = Http.emptyBody + , timeout = Nothing + , withCredentials = False + } + + +put : Endpoint -> Cred -> Body -> Decoder a -> Http.Request a +put url cred body decoder = + Endpoint.request + { method = "PUT" + , url = url + , expect = Http.expectJson decoder + , headers = [ credHeader cred ] + , body = body + , timeout = Nothing + , withCredentials = False + } + + +post : Endpoint -> Maybe Cred -> Body -> Decoder a -> Http.Request a +post url maybeCred body decoder = + Endpoint.request + { method = "POST" + , url = url + , expect = Http.expectJson decoder + , headers = + case maybeCred of + Just cred -> + [ credHeader cred ] + + Nothing -> + [] + , body = body + , timeout = Nothing + , withCredentials = False + } + + +delete : Endpoint -> Cred -> Body -> Decoder a -> Http.Request a +delete url cred body decoder = + Endpoint.request + { method = "DELETE" + , url = url + , expect = Http.expectJson decoder + , headers = [ credHeader cred ] + , body = body + , timeout = Nothing + , withCredentials = False + } + + +login : Http.Body -> Decoder (Cred -> a) -> Http.Request a +login body decoder = + post Endpoint.login Nothing body (Decode.field "user" (decoderFromCred decoder)) + + +register : Http.Body -> Decoder (Cred -> a) -> Http.Request a +register body decoder = + post Endpoint.users Nothing body (Decode.field "user" (decoderFromCred decoder)) + + +settings : Cred -> Http.Body -> Decoder (Cred -> a) -> Http.Request a +settings cred body decoder = + put Endpoint.user cred body (Decode.field "user" (decoderFromCred decoder)) + + +decoderFromCred : Decoder (Cred -> a) -> Decoder a +decoderFromCred decoder = + Decode.map2 (\fromCred cred -> fromCred cred) + decoder + credDecoder + + + +-- 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 + + + +-- LOCALSTORAGE KEYS + + +cacheStorageKey : String +cacheStorageKey = + "cache" + + +credStorageKey : String +credStorageKey = + "cred" diff --git a/src/Api/Endpoint.elm b/src/Api/Endpoint.elm new file mode 100644 index 0000000000..7812fdb2d9 --- /dev/null +++ b/src/Api/Endpoint.elm @@ -0,0 +1,127 @@ +module Api.Endpoint exposing (Endpoint, article, articles, comment, comments, favorite, feed, follow, login, profiles, request, tags, user, users) + +import Article.Slug as Slug exposing (Slug) +import CommentId exposing (CommentId) +import Http +import Url.Builder exposing (QueryParameter) +import Username exposing (Username) + + +{-| Http.request, except it takes an Endpoint instead of a Url. +-} +request : + { body : Http.Body + , expect : Http.Expect a + , headers : List Http.Header + , method : String + , timeout : Maybe Float + , url : Endpoint + , withCredentials : Bool + } + -> Http.Request a +request config = + Http.request + { body = config.body + , expect = config.expect + , headers = config.headers + , method = config.method + , timeout = config.timeout + , url = unwrap config.url + , withCredentials = config.withCredentials + } + + + +-- TYPES + + +{-| Get a URL to the Conduit API. + +This is not publicly exposed, because we want to make sure the only way to get one of these URLs is from this module. + +-} +type Endpoint + = Endpoint String + + +unwrap : Endpoint -> String +unwrap (Endpoint str) = + str + + +url : List String -> List QueryParameter -> Endpoint +url paths queryParams = + -- 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.crossOrigin "https://conduit.productionready.io" + ("api" :: paths) + queryParams + |> Endpoint + + + +-- ENDPOINTS + + +login : Endpoint +login = + url [ "users", "login" ] [] + + +user : Endpoint +user = + url [ "user" ] [] + + +users : Endpoint +users = + url [ "users" ] [] + + +follow : Username -> Endpoint +follow uname = + url [ "profiles", Username.toString uname, "follow" ] [] + + + +-- ARTICLE ENDPOINTS + + +article : Slug -> Endpoint +article slug = + url [ "articles", Slug.toString slug ] [] + + +comments : Slug -> Endpoint +comments slug = + url [ "articles", Slug.toString slug, "comments" ] [] + + +comment : Slug -> CommentId -> Endpoint +comment slug commentId = + url [ "articles", Slug.toString slug, "comments", CommentId.toString commentId ] [] + + +favorite : Slug -> Endpoint +favorite slug = + url [ "articles", Slug.toString slug, "favorite" ] [] + + +articles : List QueryParameter -> Endpoint +articles params = + url [ "articles" ] params + + +profiles : Username -> Endpoint +profiles uname = + url [ "profiles", Username.toString uname ] [] + + +feed : List QueryParameter -> Endpoint +feed params = + url [ "articles", "feed" ] params + + +tags : Endpoint +tags = + url [ "tags" ] [] diff --git a/src/Article.elm b/src/Article.elm new file mode 100644 index 0000000000..cf8e69db74 --- /dev/null +++ b/src/Article.elm @@ -0,0 +1,274 @@ +module Article exposing (Article, Full, Preview, author, body, favorite, favoriteButton, fetch, fromPreview, fullDecoder, mapAuthor, metadata, previewDecoder, slug, unfavorite, unfavoriteButton) + +{-| 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 exposing (Cred) +import Api.Endpoint as Endpoint +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 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) + + + +-- 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 - now you know why! +) + +-} +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 = + Decode.field "article" (fullDecoder maybeCred) + |> Api.get (Endpoint.article articleSlug) maybeCred + + + +-- FAVORITE + + +favorite : Slug -> Cred -> Http.Request (Article Preview) +favorite articleSlug cred = + Api.post (Endpoint.favorite articleSlug) (Just cred) Http.emptyBody (faveDecoder cred) + + +unfavorite : Slug -> Cred -> Http.Request (Article Preview) +unfavorite articleSlug cred = + Api.delete (Endpoint.favorite articleSlug) cred Http.emptyBody (faveDecoder cred) + + +faveDecoder : Cred -> Decoder (Article Preview) +faveDecoder cred = + Decode.field "article" (previewDecoder (Just cred)) + + +{-| 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 )) diff --git a/src/Article/Body.elm b/src/Article/Body.elm new file mode 100644 index 0000000000..b1c55f150f --- /dev/null +++ b/src/Article/Body.elm @@ -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 diff --git a/src/Article/Comment.elm b/src/Article/Comment.elm new file mode 100644 index 0000000000..c777c7402d --- /dev/null +++ b/src/Article/Comment.elm @@ -0,0 +1,108 @@ +module Article.Comment exposing (Comment, author, body, createdAt, delete, id, list, post) + +import Api exposing (Cred) +import Api.Endpoint as Endpoint +import Article exposing (Article) +import Article.Slug as Slug exposing (Slug) +import Author exposing (Author) +import CommentId exposing (CommentId) +import Http +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 + + + +-- 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 = + Decode.field "comments" (Decode.list (decoder maybeCred)) + |> Api.get (Endpoint.comments articleSlug) maybeCred + + + +-- POST + + +post : Slug -> String -> Cred -> Http.Request Comment +post articleSlug commentBody cred = + let + bod = + encodeCommentBody commentBody + |> Http.jsonBody + in + Decode.field "comment" (decoder (Just cred)) + |> Api.post (Endpoint.comments articleSlug) (Just cred) bod + + +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 = + Api.delete (Endpoint.comment articleSlug commentId) cred Http.emptyBody (Decode.succeed ()) + + + +-- 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 diff --git a/src/Article/Feed.elm b/src/Article/Feed.elm new file mode 100644 index 0000000000..8e4f4bd1a0 --- /dev/null +++ b/src/Article/Feed.elm @@ -0,0 +1,279 @@ +module Article.Feed exposing (Model, Msg, decoder, init, update, viewArticles, viewPagination, viewTabs) + +import Api exposing (Cred) +import Article exposing (Article, Preview) +import Article.Slug as ArticleSlug exposing (Slug) +import Article.Tag as Tag exposing (Tag) +import Author +import Avatar exposing (Avatar) +import Html exposing (..) +import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src) +import Html.Events exposing (onClick) +import Http +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 Url exposing (Url) +import Username exposing (Username) + + +{-| NOTE: This module has its own Model, view, and update. This is not normal! +If you find yourself doing this often, please watch + +This is the reusable Article Feed that appears on both the Home page as well as +on the Profile page. There's a lot of logic here, so it's more convenient to use +the heavyweight approach of giving this its own Model, view, and update. + +This means callers must use Html.map and Cmd.map to use this thing, but in +this case that's totally worth it because of the amount of logic wrapped up +in this thing. + +For every other reusable view in this application, this API would be totally +overkill, so we use simpler APIs instead. + +-} + + + +-- MODEL + + +type Model + = Model Internals + + +{-| 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 Internals = + { session : Session + , errors : List String + , articles : PaginatedList (Article Preview) + , isLoading : Bool + } + + +init : Session -> PaginatedList (Article Preview) -> Model +init session articles = + Model + { session = session + , errors = [] + , articles = articles + , isLoading = False + } + + + +-- VIEW + + +viewArticles : Time.Zone -> Model -> List (Html Msg) +viewArticles timeZone (Model { articles, session, errors }) = + let + maybeCred = + Session.cred session + + articlesHtml = + PaginatedList.values articles + |> List.map (viewPreview maybeCred timeZone) + in + Page.viewErrors ClickedDismissErrors errors :: articlesHtml + + +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..." ] + , ul [ class "tag-list" ] + (List.map viewTag (Article.metadata article).tags) + ] + ] + + +viewTabs : + List ( String, msg ) + -> ( String, msg ) + -> List ( String, msg ) + -> Html msg +viewTabs before selected after = + ul [ class "nav nav-pills outline-active" ] <| + List.concat + [ List.map (viewTab []) before + , [ viewTab [ class "active" ] selected ] + , List.map (viewTab []) after + ] + + +viewTab : List (Attribute msg) -> ( String, msg ) -> Html msg +viewTab attrs ( name, msg ) = + li [ class "nav-item" ] + [ -- Note: The RealWorld CSS requires an href to work properly. + a (class "nav-link" :: onClick msg :: href "" :: attrs) + [ text name ] + ] + + +viewPagination : (Int -> msg) -> Int -> Model -> Html msg +viewPagination toMsg page (Model feed) = + let + viewPageLink currentPage = + pageLink toMsg currentPage (currentPage == page) + + totalPages = + PaginatedList.total feed.articles + 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) ] + ] + + +viewTag : String -> Html msg +viewTag tagName = + li [ class "tag-default tag-pill tag-outline" ] [ text tagName ] + + + +-- UPDATE + + +type Msg + = ClickedDismissErrors + | ClickedFavorite Cred Slug + | ClickedUnfavorite Cred Slug + | CompletedFavorite (Result Http.Error (Article Preview)) + + +update : Maybe Cred -> Msg -> Model -> ( Model, Cmd Msg ) +update maybeCred msg (Model model) = + case msg of + ClickedDismissErrors -> + ( Model { model | errors = [] }, 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 + ) + + +replaceArticle : Article a -> Article a -> Article a +replaceArticle newArticle oldArticle = + if Article.slug newArticle == Article.slug oldArticle then + newArticle + + else + oldArticle + + + +-- SERIALIZATION + + +decoder : Maybe Cred -> Int -> Decoder (PaginatedList (Article Preview)) +decoder maybeCred resultsPerPage = + Decode.succeed PaginatedList.fromList + |> required "articlesCount" (pageCountDecoder resultsPerPage) + |> required "articles" (Decode.list (Article.previewDecoder maybeCred)) + + +pageCountDecoder : Int -> Decoder Int +pageCountDecoder resultsPerPage = + Decode.int + |> Decode.map (\total -> ceiling (toFloat total / toFloat resultsPerPage)) + + + +-- INTERNAL + + +fave : (Slug -> Cred -> Http.Request (Article Preview)) -> Cred -> Slug -> Internals -> ( Model, Cmd Msg ) +fave toRequest cred slug model = + ( Model model + , toRequest slug cred + |> Http.toTask + |> Task.attempt CompletedFavorite + ) diff --git a/src/Article/Slug.elm b/src/Article/Slug.elm new file mode 100644 index 0000000000..723f5f9db0 --- /dev/null +++ b/src/Article/Slug.elm @@ -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 diff --git a/src/Article/Tag.elm b/src/Article/Tag.elm new file mode 100644 index 0000000000..2d2c713dc3 --- /dev/null +++ b/src/Article/Tag.elm @@ -0,0 +1,42 @@ +module Article.Tag exposing (Tag, list, toString) + +import Api exposing (Cred) +import Api.Endpoint as Endpoint +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) + |> Api.get Endpoint.tags Nothing + + + +-- SERIALIZATION + + +decoder : Decoder Tag +decoder = + Decode.map Tag Decode.string diff --git a/src/Views/Assets.elm b/src/Asset.elm similarity index 55% rename from src/Views/Assets.elm rename to src/Asset.elm index 06e9cf6e21..72b396d11d 100644 --- a/src/Views/Assets.elm +++ b/src/Asset.elm @@ -1,4 +1,4 @@ -module Views.Assets exposing (error, src) +module Asset exposing (Image, defaultAvatar, error, loading, src) {-| Assets, such as images, videos, and audio. (We only have images for now.) @@ -16,16 +16,31 @@ type Image --- IMAGES -- +-- IMAGES error : Image error = - Image "/assets/images/error.jpg" + image "error.jpg" +loading : Image +loading = + image "loading.svg" --- USING IMAGES -- + +defaultAvatar : Image +defaultAvatar = + image "smiley-cyrus.jpg" + + +image : String -> Image +image filename = + Image ("/assets/images/" ++ filename) + + + +-- USING IMAGES src : Image -> Attribute msg diff --git a/src/Author.elm b/src/Author.elm new file mode 100644 index 0000000000..5a19fd912a --- /dev/null +++ b/src/Author.elm @@ -0,0 +1,234 @@ +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 exposing (Cred) +import Api.Endpoint as Endpoint +import Html exposing (Html, a, i, text) +import Html.Attributes exposing (attribute, class, href, id, placeholder) +import Html.Events exposing (onClick) +import Http +import Json.Decode as Decode exposing (Decoder) +import Json.Decode.Pipeline exposing (custom, optional, required) +import Json.Encode as Encode exposing (Value) +import Profile exposing (Profile) +import Route exposing (Route) +import Username exposing (Username) +import Viewer exposing (Viewer) + + +{-| 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 _ -> + Api.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 = + Decode.field "profile" (decoder maybeCred) + |> Api.get (Endpoint.profiles uname) maybeCred + + + +-- 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 = + Api.post (Endpoint.follow uname) (Just cred) Http.emptyBody (followDecoder cred) + + +requestUnfollow : FollowedAuthor -> Cred -> Http.Request Author +requestUnfollow (FollowedAuthor uname _) cred = + Api.delete (Endpoint.follow uname) + cred + Http.emptyBody + (followDecoder cred) + + +followDecoder : Cred -> Decoder Author +followDecoder cred = + Decode.field "profile" (decoder (Just cred)) + + +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 = + "\u{00A0}" ++ 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 == Api.username cred then + Decode.succeed (IsViewer cred prof) + + else + nonViewerDecoder prof uname + + +nonViewerDecoder : Profile -> Username -> Decoder Author +nonViewerDecoder prof uname = + Decode.succeed (authorFromFollowing prof uname) + |> optional "following" Decode.bool False + + +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 ] diff --git a/src/Avatar.elm b/src/Avatar.elm new file mode 100644 index 0000000000..7ecafb3b66 --- /dev/null +++ b/src/Avatar.elm @@ -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 diff --git a/src/CommentId.elm b/src/CommentId.elm new file mode 100644 index 0000000000..f136e1b0d2 --- /dev/null +++ b/src/CommentId.elm @@ -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 diff --git a/src/Data/Article.elm b/src/Data/Article.elm deleted file mode 100644 index 0a4b8ec9cf..0000000000 --- a/src/Data/Article.elm +++ /dev/null @@ -1,154 +0,0 @@ -module Data.Article - exposing - ( Article - , Body - , Slug - , Tag - , bodyToHtml - , bodyToMarkdownString - , decoder - , decoderWithBody - , slugParser - , slugToString - , tagDecoder - , tagToString - ) - -import Data.Article.Author as Author exposing (Author) -import Date exposing (Date) -import Html exposing (Attribute, Html) -import Json.Decode as Decode exposing (Decoder) -import Json.Decode.Extra -import Json.Decode.Pipeline exposing (custom, decode, hardcoded, required) -import Markdown -import UrlParser - - -{-| An article, optionally with an article body. - -To see the difference between { body : body } and { body : Maybe Body }, -consider the difference between the "view individual article" page (which -renders one article, including its body) and the "article feed" - -which displays multiple articles, but without bodies. - -This definition for `Article` means we can write: - -viewArticle : Article Body -> Html msg -viewFeed : List (Article ()) -> Html msg - -This indicates that `viewArticle` requires an article _with a `body` present_, -wereas `viewFeed` accepts articles with no bodies. (We could also have written -it as `List (Article a)` to specify that feeds can accept either articles that -have `body` present or not. Either work, given that feeds do not attempt to -read the `body` field from articles.) - -This is an important distinction, because in Request.Article, the `feed` -function produces `List (Article ())` because the API does not return bodies. -Those articles are useful to the feed, but not to the individual article view. - --} -type alias Article a = - { description : String - , slug : Slug - , title : String - , tags : List String - , createdAt : Date - , updatedAt : Date - , favorited : Bool - , favoritesCount : Int - , author : Author - , body : a - } - - - --- SERIALIZATION -- - - -decoder : Decoder (Article ()) -decoder = - baseArticleDecoder - |> hardcoded () - - -decoderWithBody : Decoder (Article Body) -decoderWithBody = - baseArticleDecoder - |> required "body" bodyDecoder - - -baseArticleDecoder : Decoder (a -> Article a) -baseArticleDecoder = - decode Article - |> required "description" (Decode.map (Maybe.withDefault "") (Decode.nullable Decode.string)) - |> required "slug" (Decode.map Slug Decode.string) - |> required "title" Decode.string - |> required "tagList" (Decode.list Decode.string) - |> required "createdAt" Json.Decode.Extra.date - |> required "updatedAt" Json.Decode.Extra.date - |> required "favorited" Decode.bool - |> required "favoritesCount" Decode.int - |> required "author" Author.decoder - - - --- IDENTIFIERS -- - - -type Slug - = Slug String - - -slugParser : UrlParser.Parser (Slug -> a) a -slugParser = - UrlParser.custom "SLUG" (Ok << Slug) - - -slugToString : Slug -> String -slugToString (Slug slug) = - slug - - - --- TAGS -- - - -type Tag - = Tag String - - -tagToString : Tag -> String -tagToString (Tag slug) = - slug - - -tagDecoder : Decoder Tag -tagDecoder = - Decode.map Tag Decode.string - - - --- BODY -- - - -type Body - = Body Markdown - - -type alias Markdown = - String - - -bodyToHtml : Body -> List (Attribute msg) -> Html msg -bodyToHtml (Body markdown) attributes = - Markdown.toHtml attributes markdown - - -bodyToMarkdownString : Body -> String -bodyToMarkdownString (Body markdown) = - markdown - - -bodyDecoder : Decoder Body -bodyDecoder = - Decode.map Body Decode.string diff --git a/src/Data/Article/Author.elm b/src/Data/Article/Author.elm deleted file mode 100644 index ab8f108f90..0000000000 --- a/src/Data/Article/Author.elm +++ /dev/null @@ -1,23 +0,0 @@ -module Data.Article.Author exposing (Author, decoder) - -import Data.User as User exposing (Username) -import Data.UserPhoto as UserPhoto exposing (UserPhoto) -import Json.Decode as Decode exposing (Decoder) -import Json.Decode.Pipeline exposing (custom, decode, required) - - -decoder : Decoder Author -decoder = - decode Author - |> required "username" User.usernameDecoder - |> required "bio" (Decode.nullable Decode.string) - |> required "image" UserPhoto.decoder - |> required "following" Decode.bool - - -type alias Author = - { username : Username - , bio : Maybe String - , image : UserPhoto - , following : Bool - } diff --git a/src/Data/Article/Comment.elm b/src/Data/Article/Comment.elm deleted file mode 100644 index bd219b3140..0000000000 --- a/src/Data/Article/Comment.elm +++ /dev/null @@ -1,48 +0,0 @@ -module Data.Article.Comment exposing (Comment, CommentId, commentIdDecoder, decoder, idToString) - -import Data.Article.Author as Author exposing (Author) -import Date exposing (Date) -import Json.Decode as Decode exposing (Decoder) -import Json.Decode.Extra -import Json.Decode.Pipeline exposing (custom, decode, required) - - -type alias Comment = - { id : CommentId - , body : String - , createdAt : Date - , updatedAt : Date - , author : Author - } - - - --- SERIALIZATION -- - - -decoder : Decoder Comment -decoder = - decode Comment - |> required "id" commentIdDecoder - |> required "body" Decode.string - |> required "createdAt" Json.Decode.Extra.date - |> required "updatedAt" Json.Decode.Extra.date - |> required "author" Author.decoder - - - --- IDENTIFIERS -- - - -type CommentId - = CommentId Int - - -idToString : CommentId -> String -idToString (CommentId id) = - toString id - - -commentIdDecoder : Decoder CommentId -commentIdDecoder = - Decode.map CommentId Decode.int diff --git a/src/Data/Article/Feed.elm b/src/Data/Article/Feed.elm deleted file mode 100644 index 3f7a41ae65..0000000000 --- a/src/Data/Article/Feed.elm +++ /dev/null @@ -1,22 +0,0 @@ -module Data.Article.Feed exposing (Feed, decoder) - -import Data.Article as Article exposing (Article) -import Json.Decode as Decode exposing (Decoder) -import Json.Decode.Pipeline exposing (decode, required) - - -type alias Feed = - { articles : List (Article ()) - , articlesCount : Int - } - - - --- SERIALIZATION -- - - -decoder : Decoder Feed -decoder = - decode Feed - |> required "articles" (Decode.list Article.decoder) - |> required "articlesCount" Decode.int diff --git a/src/Data/AuthToken.elm b/src/Data/AuthToken.elm deleted file mode 100644 index ca927c06e2..0000000000 --- a/src/Data/AuthToken.elm +++ /dev/null @@ -1,31 +0,0 @@ -module Data.AuthToken exposing (AuthToken, decoder, encode, withAuthorization) - -import HttpBuilder exposing (RequestBuilder, withHeader) -import Json.Decode as Decode exposing (Decoder) -import Json.Encode as Encode exposing (Value) - - -type AuthToken - = AuthToken String - - -encode : AuthToken -> Value -encode (AuthToken token) = - Encode.string token - - -decoder : Decoder AuthToken -decoder = - Decode.string - |> Decode.map AuthToken - - -withAuthorization : Maybe AuthToken -> RequestBuilder a -> RequestBuilder a -withAuthorization maybeToken builder = - case maybeToken of - Just (AuthToken token) -> - builder - |> withHeader "authorization" ("Token " ++ token) - - Nothing -> - builder diff --git a/src/Data/Profile.elm b/src/Data/Profile.elm deleted file mode 100644 index 18a90227b2..0000000000 --- a/src/Data/Profile.elm +++ /dev/null @@ -1,23 +0,0 @@ -module Data.Profile exposing (Profile, decoder) - -import Data.User as User exposing (Username) -import Data.UserPhoto as UserPhoto exposing (UserPhoto) -import Json.Decode as Decode exposing (Decoder) -import Json.Decode.Pipeline exposing (decode, required) - - -type alias Profile = - { username : Username - , bio : Maybe String - , image : UserPhoto - , following : Bool - } - - -decoder : Decoder Profile -decoder = - decode Profile - |> required "username" User.usernameDecoder - |> required "bio" (Decode.nullable Decode.string) - |> required "image" UserPhoto.decoder - |> required "following" Decode.bool diff --git a/src/Data/Session.elm b/src/Data/Session.elm deleted file mode 100644 index 05f017c064..0000000000 --- a/src/Data/Session.elm +++ /dev/null @@ -1,19 +0,0 @@ -module Data.Session exposing (Session, attempt) - -import Data.AuthToken exposing (AuthToken) -import Data.User exposing (User) -import Util exposing ((=>)) - - -type alias Session = - { user : Maybe User } - - -attempt : String -> (AuthToken -> Cmd msg) -> Session -> ( List String, Cmd msg ) -attempt attemptedAction toCmd session = - case Maybe.map .token session.user of - Nothing -> - [ "You have been signed out. Please sign back in to " ++ attemptedAction ++ "." ] => Cmd.none - - Just token -> - [] => toCmd token diff --git a/src/Data/User.elm b/src/Data/User.elm deleted file mode 100644 index 39400ad12a..0000000000 --- a/src/Data/User.elm +++ /dev/null @@ -1,84 +0,0 @@ -module Data.User exposing (User, Username, decoder, encode, usernameDecoder, usernameParser, usernameToHtml, usernameToString) - -import Data.AuthToken as AuthToken exposing (AuthToken) -import Data.UserPhoto as UserPhoto exposing (UserPhoto) -import Html exposing (Html) -import Json.Decode as Decode exposing (Decoder) -import Json.Decode.Pipeline exposing (decode, required) -import Json.Encode as Encode exposing (Value) -import Json.Encode.Extra as EncodeExtra -import UrlParser -import Util exposing ((=>)) - - -type alias User = - { email : String - , token : AuthToken - , username : Username - , bio : Maybe String - , image : UserPhoto - , createdAt : String - , updatedAt : String - } - - - --- SERIALIZATION -- - - -decoder : Decoder User -decoder = - decode User - |> required "email" Decode.string - |> required "token" AuthToken.decoder - |> required "username" usernameDecoder - |> required "bio" (Decode.nullable Decode.string) - |> required "image" UserPhoto.decoder - |> required "createdAt" Decode.string - |> required "updatedAt" Decode.string - - -encode : User -> Value -encode user = - Encode.object - [ "email" => Encode.string user.email - , "token" => AuthToken.encode user.token - , "username" => encodeUsername user.username - , "bio" => EncodeExtra.maybe Encode.string user.bio - , "image" => UserPhoto.encode user.image - , "createdAt" => Encode.string user.createdAt - , "updatedAt" => Encode.string user.updatedAt - ] - - - --- IDENTIFIERS -- - - -type Username - = Username String - - -usernameToString : Username -> String -usernameToString (Username username) = - username - - -usernameParser : UrlParser.Parser (Username -> a) a -usernameParser = - UrlParser.custom "USERNAME" (Ok << Username) - - -usernameDecoder : Decoder Username -usernameDecoder = - Decode.map Username Decode.string - - -encodeUsername : Username -> Value -encodeUsername (Username username) = - Encode.string username - - -usernameToHtml : Username -> Html msg -usernameToHtml (Username username) = - Html.text username diff --git a/src/Data/UserPhoto.elm b/src/Data/UserPhoto.elm deleted file mode 100644 index a97715c22b..0000000000 --- a/src/Data/UserPhoto.elm +++ /dev/null @@ -1,45 +0,0 @@ -module Data.UserPhoto exposing (UserPhoto, decoder, encode, src, toMaybeString) - -import Html exposing (Attribute) -import Html.Attributes -import Json.Decode as Decode exposing (Decoder) -import Json.Encode as Encode exposing (Value) -import Json.Encode.Extra as EncodeExtra - - -type UserPhoto - = UserPhoto (Maybe String) - - -src : UserPhoto -> Attribute msg -src = - photoToUrl >> Html.Attributes.src - - -decoder : Decoder UserPhoto -decoder = - Decode.map UserPhoto (Decode.nullable Decode.string) - - -encode : UserPhoto -> Value -encode (UserPhoto maybeUrl) = - EncodeExtra.maybe Encode.string maybeUrl - - -toMaybeString : UserPhoto -> Maybe String -toMaybeString (UserPhoto maybeUrl) = - maybeUrl - - - --- INTERNAL -- - - -photoToUrl : UserPhoto -> String -photoToUrl (UserPhoto maybeUrl) = - case maybeUrl of - Nothing -> - "https://static.productionready.io/images/smiley-cyrus.jpg" - - Just url -> - url diff --git a/src/Email.elm b/src/Email.elm new file mode 100644 index 0000000000..f696c01abb --- /dev/null +++ b/src/Email.elm @@ -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 diff --git a/src/Loading.elm b/src/Loading.elm new file mode 100644 index 0000000000..2eba30199c --- /dev/null +++ b/src/Loading.elm @@ -0,0 +1,31 @@ +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 diff --git a/src/Log.elm b/src/Log.elm new file mode 100644 index 0000000000..fe6111ec7b --- /dev/null +++ b/src/Log.elm @@ -0,0 +1,20 @@ +module Log exposing (error) + +{-| This is a placeholder API for how we might do logging through +some service like (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 diff --git a/src/Main.elm b/src/Main.elm index cab75c2f17..6c8ee2b314 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -1,25 +1,30 @@ module Main exposing (main) -import Data.Article exposing (Slug) -import Data.Session exposing (Session) -import Data.User as User exposing (User, Username) +import Api exposing (Cred) +import Article.Slug exposing (Slug) +import Avatar exposing (Avatar) +import Browser exposing (Document) +import Browser.Navigation as Nav import Html exposing (..) import Json.Decode as Decode exposing (Value) -import Navigation exposing (Location) +import Page exposing (Page) import Page.Article as Article import Page.Article.Editor as Editor -import Page.Errored as Errored exposing (PageLoadError) +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 Ports import Route exposing (Route) +import Session exposing (Session) import Task -import Util exposing ((=>)) -import Views.Page as Page exposing (ActivePage) +import Time +import Url exposing (Url) +import Username exposing (Username) +import Viewer exposing (Viewer) + -- WARNING: Based on discussions around how asset management features @@ -28,10 +33,9 @@ import Views.Page as Page exposing (ActivePage) -- Avoid putting things in here unless there is no alternative! -type Page - = Blank - | NotFound - | Errored PageLoadError +type Model + = Redirect Session + | NotFound Session | Home Home.Model | Settings Settings.Model | Login Login.Model @@ -41,431 +45,291 @@ type Page | Editor (Maybe Slug) Editor.Model -type PageState - = Loaded Page - | TransitioningFrom Page - - --- MODEL -- +-- MODEL -type alias Model = - { session : Session - , pageState : PageState - } - - -init : Value -> Location -> ( Model, Cmd Msg ) -init val location = - setRoute (Route.fromLocation location) - { pageState = Loaded initialPage - , session = { user = decodeUserFromJson val } - } +init : Maybe Viewer -> Url -> Nav.Key -> ( Model, Cmd Msg ) +init maybeViewer url navKey = + changeRouteTo (Route.fromUrl url) + (Redirect (Session.fromViewer navKey maybeViewer)) -decodeUserFromJson : Value -> Maybe User -decodeUserFromJson json = - json - |> Decode.decodeValue Decode.string - |> Result.toMaybe - |> Maybe.andThen (Decode.decodeString User.decoder >> Result.toMaybe) +-- VIEW -initialPage : Page -initialPage = - Blank - - --- VIEW -- - - -view : Model -> Html Msg +view : Model -> Document Msg view model = - case model.pageState of - Loaded page -> - viewPage model.session False page - - TransitioningFrom page -> - viewPage model.session True page - - -viewPage : Session -> Bool -> Page -> Html Msg -viewPage session isLoading page = let - frame = - Page.frame isLoading session.user - in - case page of - NotFound -> - NotFound.view session - |> frame Page.Other - - Blank -> - -- This is for the very initial page load, while we are loading - -- data via HTTP. We could also render a spinner here. - Html.text "" - |> frame Page.Other - - Errored subModel -> - Errored.view session subModel - |> frame Page.Other - - Settings subModel -> - Settings.view session subModel - |> frame Page.Other - |> Html.map SettingsMsg - - Home subModel -> - Home.view session subModel - |> frame Page.Home - |> Html.map HomeMsg - - Login subModel -> - Login.view session subModel - |> frame Page.Other - |> Html.map LoginMsg - - Register subModel -> - Register.view session subModel - |> frame Page.Other - |> Html.map RegisterMsg - - Profile username subModel -> - Profile.view session subModel - |> frame (Page.Profile username) - |> Html.map ProfileMsg - - Article subModel -> - Article.view session subModel - |> frame Page.Other - |> Html.map ArticleMsg - - Editor maybeSlug subModel -> + viewPage page toMsg config = let - framePage = - if maybeSlug == Nothing then - Page.NewArticle - else - Page.Other + { title, body } = + Page.view (Session.viewer (toSession model)) page config in - Editor.view subModel - |> frame framePage - |> Html.map EditorMsg - - + { title = title + , body = List.map (Html.map toMsg) body + } + in + case model of + Redirect _ -> + viewPage Page.Other (\_ -> Ignored) Blank.view --- SUBSCRIPTIONS -- --- Note: we aren't currently doing any page subscriptions, but I thought it would --- be a good idea to put this in here as an example. If I were actually --- maintaining this in production, I wouldn't bother until I needed this! + NotFound _ -> + viewPage Page.Other (\_ -> Ignored) NotFound.view + Settings settings -> + viewPage Page.Other GotSettingsMsg (Settings.view settings) -subscriptions : Model -> Sub Msg -subscriptions model = - Sub.batch - [ pageSubscriptions (getPage model.pageState) - , Sub.map SetUser sessionChange - ] + Home home -> + viewPage Page.Home GotHomeMsg (Home.view home) + Login login -> + viewPage Page.Other GotLoginMsg (Login.view login) -sessionChange : Sub (Maybe User) -sessionChange = - Ports.onSessionChange (Decode.decodeValue User.decoder >> Result.toMaybe) + Register register -> + viewPage Page.Other GotRegisterMsg (Register.view register) + Profile username profile -> + viewPage (Page.Profile username) GotProfileMsg (Profile.view profile) -getPage : PageState -> Page -getPage pageState = - case pageState of - Loaded page -> - page + Article article -> + viewPage Page.Other GotArticleMsg (Article.view article) - TransitioningFrom page -> - page + Editor Nothing editor -> + viewPage Page.NewArticle GotEditorMsg (Editor.view editor) + Editor (Just _) editor -> + viewPage Page.Other GotEditorMsg (Editor.view editor) -pageSubscriptions : Page -> Sub Msg -pageSubscriptions page = - case page of - Blank -> - Sub.none - Errored _ -> - Sub.none - NotFound -> - Sub.none +-- UPDATE - Settings _ -> - Sub.none - Home _ -> - Sub.none +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 - Login _ -> - Sub.none + NotFound session -> + session - Register _ -> - Sub.none + Home home -> + Home.toSession home - Profile _ _ -> - Sub.none + Settings settings -> + Settings.toSession settings - Article _ -> - Sub.none + Login login -> + Login.toSession login - Editor _ _ -> - Sub.none + Register register -> + Register.toSession register + Profile _ profile -> + Profile.toSession profile + Article article -> + Article.toSession article --- UPDATE -- + Editor _ editor -> + Editor.toSession editor -type Msg - = SetRoute (Maybe Route) - | HomeLoaded (Result PageLoadError Home.Model) - | ArticleLoaded (Result PageLoadError Article.Model) - | ProfileLoaded Username (Result PageLoadError Profile.Model) - | EditArticleLoaded Slug (Result PageLoadError Editor.Model) - | HomeMsg Home.Msg - | SettingsMsg Settings.Msg - | SetUser (Maybe User) - | LoginMsg Login.Msg - | RegisterMsg Register.Msg - | ProfileMsg Profile.Msg - | ArticleMsg Article.Msg - | EditorMsg Editor.Msg - - -setRoute : Maybe Route -> Model -> ( Model, Cmd Msg ) -setRoute maybeRoute model = +changeRouteTo : Maybe Route -> Model -> ( Model, Cmd Msg ) +changeRouteTo maybeRoute model = let - transition toMsg task = - { model | pageState = TransitioningFrom (getPage model.pageState) } - => Task.attempt toMsg task - - errored = - pageErrored model + session = + toSession model in case maybeRoute of Nothing -> - { model | pageState = Loaded NotFound } => Cmd.none + ( NotFound session, Cmd.none ) - Just Route.NewArticle -> - case model.session.user of - Just user -> - { model | pageState = Loaded (Editor Nothing Editor.initNew) } => Cmd.none + Just Route.Root -> + ( model, Route.replaceUrl (Session.navKey session) Route.Home ) - Nothing -> - errored Page.NewArticle "You must be signed in to post an article." + Just Route.Logout -> + ( model, Api.logout ) - Just (Route.EditArticle slug) -> - case model.session.user of - Just user -> - transition (EditArticleLoaded slug) (Editor.initEdit model.session slug) + Just Route.NewArticle -> + Editor.initNew session + |> updateWith (Editor Nothing) GotEditorMsg model - Nothing -> - errored Page.Other "You must be signed in to edit an article." + Just (Route.EditArticle slug) -> + Editor.initEdit session slug + |> updateWith (Editor (Just slug)) GotEditorMsg model Just Route.Settings -> - case model.session.user of - Just user -> - { model | pageState = Loaded (Settings (Settings.init user)) } => Cmd.none - - Nothing -> - errored Page.Settings "You must be signed in to access your settings." + Settings.init session + |> updateWith Settings GotSettingsMsg model Just Route.Home -> - transition HomeLoaded (Home.init model.session) - - Just Route.Root -> - model => Route.modifyUrl Route.Home + Home.init session + |> updateWith Home GotHomeMsg model Just Route.Login -> - { model | pageState = Loaded (Login Login.initialModel) } => Cmd.none - - Just Route.Logout -> - let - session = - model.session - in - { model | session = { session | user = Nothing } } - => Cmd.batch - [ Ports.storeSession Nothing - , Route.modifyUrl Route.Home - ] + Login.init session + |> updateWith Login GotLoginMsg model Just Route.Register -> - { model | pageState = Loaded (Register Register.initialModel) } => Cmd.none + Register.init session + |> updateWith Register GotRegisterMsg model Just (Route.Profile username) -> - transition (ProfileLoaded username) (Profile.init model.session username) + Profile.init session username + |> updateWith (Profile username) GotProfileMsg model Just (Route.Article slug) -> - transition ArticleLoaded (Article.init model.session slug) - - -pageErrored : Model -> ActivePage -> String -> ( Model, Cmd msg ) -pageErrored model activePage errorMessage = - let - error = - Errored.pageLoadError activePage errorMessage - in - { model | pageState = Loaded (Errored error) } => Cmd.none + Article.init session slug + |> updateWith Article GotArticleMsg model update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = - updatePage (getPage model.pageState) msg model - - -updatePage : Page -> Msg -> Model -> ( Model, Cmd Msg ) -updatePage page msg model = - let - session = - model.session - - toPage toModel toMsg subUpdate subMsg subModel = - let - ( newModel, newCmd ) = - subUpdate subMsg subModel - in - ( { model | pageState = Loaded (toModel newModel) }, Cmd.map toMsg newCmd ) - - errored = - pageErrored model - in - case ( msg, page ) of - ( SetRoute route, _ ) -> - setRoute route model - - ( HomeLoaded (Ok subModel), _ ) -> - { model | pageState = Loaded (Home subModel) } => Cmd.none - - ( HomeLoaded (Err error), _ ) -> - { model | pageState = Loaded (Errored error) } => Cmd.none - - ( ProfileLoaded username (Ok subModel), _ ) -> - { model | pageState = Loaded (Profile username subModel) } => Cmd.none - - ( ProfileLoaded username (Err error), _ ) -> - { model | pageState = Loaded (Errored error) } => Cmd.none + 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 + ) - ( ArticleLoaded (Ok subModel), _ ) -> - { model | pageState = Loaded (Article subModel) } => Cmd.none - - ( ArticleLoaded (Err error), _ ) -> - { model | pageState = Loaded (Errored error) } => Cmd.none - - ( EditArticleLoaded slug (Ok subModel), _ ) -> - { model | pageState = Loaded (Editor (Just slug) subModel) } => Cmd.none - - ( EditArticleLoaded slug (Err error), _ ) -> - { model | pageState = Loaded (Errored error) } => Cmd.none - - ( SetUser user, _ ) -> - let - cmd = - -- If we just signed out, then redirect to Home. - if session.user /= Nothing && user == Nothing then - Route.modifyUrl Route.Home - else - Cmd.none - in - { model | session = { session | user = user } } - => cmd + ( _, _ ) -> + -- Disregard messages that arrived for the wrong page. + ( model, Cmd.none ) - ( SettingsMsg subMsg, Settings subModel ) -> - let - ( ( pageModel, cmd ), msgFromPage ) = - Settings.update model.session subMsg subModel - newModel = - case msgFromPage of - Settings.NoOp -> - model +updateWith : (subModel -> Model) -> (subMsg -> Msg) -> Model -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg ) +updateWith toModel toMsg model ( subModel, subCmd ) = + ( toModel subModel + , Cmd.map toMsg subCmd + ) - Settings.SetUser user -> - { model | session = { user = Just user } } - in - { newModel | pageState = Loaded (Settings pageModel) } - => Cmd.map SettingsMsg cmd - - ( LoginMsg subMsg, Login subModel ) -> - let - ( ( pageModel, cmd ), msgFromPage ) = - Login.update subMsg subModel - newModel = - case msgFromPage of - Login.NoOp -> - model - Login.SetUser user -> - { model | session = { user = Just user } } - in - { newModel | pageState = Loaded (Login pageModel) } - => Cmd.map LoginMsg cmd +-- SUBSCRIPTIONS - ( RegisterMsg subMsg, Register subModel ) -> - let - ( ( pageModel, cmd ), msgFromPage ) = - Register.update subMsg subModel - newModel = - case msgFromPage of - Register.NoOp -> - model +subscriptions : Model -> Sub Msg +subscriptions model = + case model of + NotFound _ -> + Sub.none - Register.SetUser user -> - { model | session = { user = Just user } } - in - { newModel | pageState = Loaded (Register pageModel) } - => Cmd.map RegisterMsg cmd + Redirect _ -> + Session.changes GotSession (Session.navKey (toSession model)) - ( HomeMsg subMsg, Home subModel ) -> - toPage Home HomeMsg (Home.update session) subMsg subModel + Settings settings -> + Sub.map GotSettingsMsg (Settings.subscriptions settings) - ( ProfileMsg subMsg, Profile username subModel ) -> - toPage (Profile username) ProfileMsg (Profile.update model.session) subMsg subModel + Home home -> + Sub.map GotHomeMsg (Home.subscriptions home) - ( ArticleMsg subMsg, Article subModel ) -> - toPage Article ArticleMsg (Article.update model.session) subMsg subModel + Login login -> + Sub.map GotLoginMsg (Login.subscriptions login) - ( EditorMsg subMsg, Editor slug subModel ) -> - case model.session.user of - Nothing -> - if slug == Nothing then - errored Page.NewArticle - "You must be signed in to post articles." - else - errored Page.Other - "You must be signed in to edit articles." + Register register -> + Sub.map GotRegisterMsg (Register.subscriptions register) - Just user -> - toPage (Editor slug) EditorMsg (Editor.update user) subMsg subModel + Profile _ profile -> + Sub.map GotProfileMsg (Profile.subscriptions profile) - ( _, NotFound ) -> - -- Disregard incoming messages when we're on the - -- NotFound page. - model => Cmd.none + Article article -> + Sub.map GotArticleMsg (Article.subscriptions article) - ( _, _ ) -> - -- Disregard incoming messages that arrived for the wrong page - model => Cmd.none + Editor _ editor -> + Sub.map GotEditorMsg (Editor.subscriptions editor) --- MAIN -- +-- MAIN main : Program Value Model Msg main = - Navigation.programWithFlags (Route.fromLocation >> SetRoute) + Api.application Viewer.decoder { init = init - , view = view - , update = update + , onUrlChange = ChangedUrl + , onUrlRequest = ClickedLink , subscriptions = subscriptions + , update = update + , view = view } diff --git a/src/Views/Page.elm b/src/Page.elm similarity index 53% rename from src/Views/Page.elm rename to src/Page.elm index a73f0dcec2..f1790bff6f 100644 --- a/src/Views/Page.elm +++ b/src/Page.elm @@ -1,16 +1,16 @@ -module Views.Page exposing (ActivePage(..), bodyId, frame) - -{-| The frame around a typical page - that is, the header and footer. --} - -import Data.User as User exposing (User, Username) -import Data.UserPhoto as UserPhoto exposing (UserPhoto) -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Lazy exposing (lazy2) +module Page exposing (Page(..), view, viewErrors) + +import Api exposing (Cred) +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 Util exposing ((=>)) -import Views.Spinner exposing (spinner) +import Session exposing (Session) +import Username exposing (Username) +import Viewer exposing (Viewer) {-| Determines which navbar link (if any) will be rendered as active. @@ -20,7 +20,7 @@ have links for every page. Anything that's not part of the navbar falls under Other. -} -type ActivePage +type Page = Other | Home | Login @@ -30,7 +30,7 @@ type ActivePage | NewArticle -{-| Take a page's Html and frame it with a header and footer. +{-| 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. @@ -39,52 +39,56 @@ isLoading is for determining whether we should show a loading spinner in the header. (This comes up during slow page transitions.) -} -frame : Bool -> Maybe User -> ActivePage -> Html msg -> Html msg -frame isLoading user page content = - div [ class "page-frame" ] - [ viewHeader page user isLoading - , content - , viewFooter - ] +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 : ActivePage -> Maybe User -> Bool -> Html msg -viewHeader page user isLoading = +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" ] <| - lazy2 Util.viewIf isLoading spinner - :: navbarLink page Route.Home [ text "Home" ] - :: viewSignIn page user + navbarLink page Route.Home [ text "Home" ] + :: viewMenu page maybeViewer ] ] -viewSignIn : ActivePage -> Maybe User -> List (Html msg) -viewSignIn page user = +viewMenu : Page -> Maybe Viewer -> List (Html msg) +viewMenu page maybeViewer = let linkTo = navbarLink page in - case user of - Nothing -> - [ linkTo Route.Login [ text "Sign in" ] - , linkTo Route.Register [ text "Sign up" ] - ] - - Just user -> - [ linkTo Route.NewArticle [ i [ class "ion-compose" ] [], text " New Post" ] - , linkTo Route.Settings [ i [ class "ion-gear-a" ] [], text " Settings" ] + case maybeViewer of + Just viewer -> + let + username = + Viewer.username viewer + + avatar = + Viewer.avatar viewer + in + [ linkTo Route.NewArticle [ i [ class "ion-compose" ] [], text "\u{00A0}New Post" ] + , linkTo Route.Settings [ i [ class "ion-gear-a" ] [], text "\u{00A0}Settings" ] , linkTo - (Route.Profile user.username) - [ img [ class "user-pic", UserPhoto.src user.image ] [] - , User.usernameToHtml user.username + (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 = @@ -100,13 +104,13 @@ viewFooter = ] -navbarLink : ActivePage -> Route -> List (Html msg) -> Html msg +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 : ActivePage -> Route -> Bool +isActive : Page -> Route -> Bool isActive page route = case ( page, route ) of ( Home, Route.Home ) -> @@ -131,12 +135,22 @@ isActive page route = False -{-| This id comes from index.html. - -The Feed uses it to scroll to the top of the page (by ID) when switching pages -in the pagination sense. - +{-| Render dismissable errors. We use this all over the place! -} -bodyId : String -bodyId = - "page-body" +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" ] ] diff --git a/src/Page/Article.elm b/src/Page/Article.elm index 1c5e71c5a3..1ef0d6e16f 100644 --- a/src/Page/Article.elm +++ b/src/Page/Article.elm @@ -1,401 +1,586 @@ -module Page.Article exposing (Model, Msg, init, update, view) +module Page.Article exposing (Model, Msg, init, subscriptions, toSession, update, view) {-| Viewing an individual article. -} -import Data.Article as Article exposing (Article, Body) -import Data.Article.Author exposing (Author) -import Data.Article.Comment exposing (Comment, CommentId) -import Data.Session as Session exposing (Session) -import Data.User as User exposing (User) -import Data.UserPhoto as UserPhoto -import Date exposing (Date) -import Date.Format +import Api exposing (Cred) +import Api.Endpoint as Endpoint +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.Attributes exposing (attribute, class, disabled, href, id, placeholder, value) import Html.Events exposing (onClick, onInput, onSubmit) import Http -import Page.Errored exposing (PageLoadError, pageLoadError) -import Request.Article -import Request.Article.Comments -import Request.Profile +import Json.Decode as Decode +import Loading +import Log +import Page +import Profile exposing (Profile) import Route +import Session exposing (Session) import Task exposing (Task) -import Util exposing ((=>), pair, viewIf) -import Views.Article -import Views.Article.Favorite as Favorite -import Views.Author -import Views.Errors -import Views.Page as Page -import Views.User.Follow as Follow +import Time +import Timestamp +import Username exposing (Username) +import Viewer exposing (Viewer) --- MODEL -- + +-- MODEL type alias Model = - { errors : List String - , commentText : String - , commentInFlight : Bool - , article : Article Body - , comments : List Comment + { session : Session + , timeZone : Time.Zone + , errors : List String + + -- Loaded independently from server + , comments : Status ( CommentText, List Comment ) + , article : Status (Article Full) } -init : Session -> Article.Slug -> Task PageLoadError Model +type Status a + = Loading + | LoadingSlowly + | Loaded a + | Failed + + +type CommentText + = Editing String + | Sending String + + +init : Session -> Slug -> ( Model, Cmd Msg ) init session slug = let - maybeAuthToken = - Maybe.map .token session.user + 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 + ] + ) - loadArticle = - Request.Article.get maybeAuthToken slug - |> Http.toTask - loadComments = - Request.Article.Comments.list maybeAuthToken slug - |> Http.toTask - handleLoadError _ = - pageLoadError Page.Other "Article is currently unavailable." - in - Task.map2 (Model [] "" False) loadArticle loadComments - |> Task.mapError handleLoadError +-- VIEW +view : Model -> { title : String, content : Html Msg } +view model = + case model.article of + Loaded article -> + let + { title } = + Article.metadata article --- VIEW -- + author = + Article.author article + avatar = + Profile.avatar (Author.profile author) -view : Session -> Model -> Html Msg -view session model = - let - article = - model.article + slug = + Article.slug article - author = - article.author + profile = + Author.profile author - buttons = - viewButtons article author session.user + buttons = + case Session.cred model.session of + Just cred -> + viewButtons cred article author - postingDisabled = - model.commentInFlight - in - div [ class "article-page" ] - [ viewBanner model.errors article author session.user - , div [ class "container page" ] - [ div [ class "row article-content" ] - [ div [ class "col-md-12" ] - [ Article.bodyToHtml article.body [] ] - ] - , hr [] [] - , div [ class "article-actions" ] - [ div [ class "article-meta" ] <| - [ a [ Route.href (Route.Profile author.username) ] - [ img [ UserPhoto.src author.image ] [] ] - , div [ class "info" ] - [ Views.Author.view author.username - , Views.Article.viewTimestamp article + 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" ] + ] ] ] - ++ buttons - ] - , div [ class "row" ] - [ div [ class "col-xs-12 col-md-8 offset-md-2" ] <| - viewAddComment postingDisabled session.user - :: List.map (viewComment session.user) model.comments - ] - ] - ] + } + Loading -> + { title = "Article", content = text "" } -viewBanner : List String -> Article a -> Author -> Maybe User -> Html Msg -viewBanner errors article author maybeUser = - let - buttons = - viewButtons article author maybeUser - in - div [ class "banner" ] - [ div [ class "container" ] - [ h1 [] [ text article.title ] - , div [ class "article-meta" ] <| - [ a [ Route.href (Route.Profile author.username) ] - [ img [ UserPhoto.src author.image ] [] ] - , div [ class "info" ] - [ Views.Author.view author.username - , Views.Article.viewTimestamp article - ] - ] - ++ buttons - , Views.Errors.view DismissErrors errors - ] - ] + LoadingSlowly -> + { title = "Article", content = Loading.icon } + Failed -> + { title = "Article", content = Loading.error "article" } -viewAddComment : Bool -> Maybe User -> Html Msg -viewAddComment postingDisabled maybeUser = - case maybeUser of - Nothing -> - p [] - [ a [ Route.href Route.Login ] [ text "Sign in" ] - , text " or " - , a [ Route.href Route.Register ] [ text "sign up" ] - , text " to add comments on this article." - ] - Just user -> - Html.form [ class "card comment-form", onSubmit PostComment ] +viewAddComment : Slug -> CommentText -> Maybe Viewer -> Html Msg +viewAddComment slug commentText maybeViewer = + case maybeViewer of + Just viewer -> + let + avatar = + Viewer.avatar 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 SetCommentText + , onInput EnteredCommentText + , value commentStr ] [] ] , div [ class "card-footer" ] - [ img [ class "comment-author-img", UserPhoto.src user.image ] [] + [ img [ class "comment-author-img", Avatar.src avatar ] [] , button - [ class "btn btn-sm btn-primary" - , disabled postingDisabled - ] + (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 : Article a -> Author -> Maybe User -> List (Html Msg) -viewButtons article author maybeUser = - let - isMyArticle = - Maybe.map .username maybeUser == Just author.username - in - if isMyArticle then - [ editButton article - , text " " - , deleteButton article - ] - else - [ followButton author - , text " " - , favoriteButton article - ] +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 : Maybe User -> Comment -> Html Msg -viewComment user comment = + +viewComment : Time.Zone -> Slug -> Comment -> Html Msg +viewComment timeZone slug comment = let author = - comment.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 "" - isAuthor = - Maybe.map .username user == Just comment.author.username + timestamp = + Timestamp.format timeZone (Comment.createdAt comment) in div [ class "card" ] [ div [ class "card-block" ] - [ p [ class "card-text" ] [ text comment.body ] ] + [ p [ class "card-text" ] [ text (Comment.body comment) ] ] , div [ class "card-footer" ] [ a [ class "comment-author", href "" ] - [ img [ class "comment-author-img", UserPhoto.src author.image ] [] + [ img [ class "comment-author-img", Avatar.src (Profile.avatar profile) ] [] , text " " ] , text " " - , a [ class "comment-author", Route.href (Route.Profile author.username) ] - [ text (User.usernameToString comment.author.username) ] - , span [ class "date-posted" ] [ text (formatCommentTimestamp comment.createdAt) ] - , viewIf isAuthor <| - span - [ class "mod-options" - , onClick (DeleteComment comment.id) - ] - [ i [ class "ion-trash-a" ] [] ] + , a [ class "comment-author", Route.href (Route.Profile authorUsername) ] + [ text (Username.toString authorUsername) ] + , span [ class "date-posted" ] [ text timestamp ] + , deleteCommentButton ] ] -formatCommentTimestamp : Date -> String -formatCommentTimestamp = - Date.Format.format "%B %e, %Y" - - --- UPDATE -- +-- UPDATE type Msg - = DismissErrors - | ToggleFavorite - | FavoriteCompleted (Result Http.Error (Article Body)) - | ToggleFollow - | FollowCompleted (Result Http.Error Author) - | SetCommentText String - | DeleteComment CommentId - | CommentDeleted CommentId (Result Http.Error ()) - | PostComment - | CommentPosted (Result Http.Error Comment) - | DeleteArticle - | ArticleDeleted (Result Http.Error ()) - - -update : Session -> Msg -> Model -> ( Model, Cmd Msg ) -update session msg model = - let - article = - model.article - - author = - article.author - in + = 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 - DismissErrors -> - { model | errors = [] } => Cmd.none - - ToggleFavorite -> + 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 - cmdFromAuth authToken = - Request.Article.toggleFavorite model.article authToken - |> Http.toTask - |> Task.map (\newArticle -> { newArticle | body = article.body }) - |> Task.attempt FavoriteCompleted + -- 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 - session - |> Session.attempt "favorite" cmdFromAuth - |> Tuple.mapFirst (Util.appendErrors model) + ( { model | article = article, comments = comments }, Cmd.none ) - FavoriteCompleted (Ok newArticle) -> - { model | article = newArticle } => Cmd.none - FavoriteCompleted (Err error) -> - -- In a serious production application, we would log the error to - -- a logging service so we could investigate later. - [ "There was a server error trying to record your Favorite. Sorry!" ] - |> Util.appendErrors model - => Cmd.none - ToggleFollow -> - let - cmdFromAuth authToken = - authToken - |> Request.Profile.toggleFollow author.username author.following - |> Http.send FollowCompleted - in - session - |> Session.attempt "follow" cmdFromAuth - |> Tuple.mapFirst (Util.appendErrors model) +-- SUBSCRIPTIONS - FollowCompleted (Ok { following }) -> - let - newArticle = - { article | author = { author | following = following } } - in - { model | article = newArticle } => Cmd.none - FollowCompleted (Err error) -> - { model | errors = "Unable to follow user." :: model.errors } - => Cmd.none +subscriptions : Model -> Sub Msg +subscriptions model = + Session.changes GotSession (Session.navKey model.session) - SetCommentText commentText -> - { model | commentText = commentText } => Cmd.none - PostComment -> - let - comment = - model.commentText - in - if model.commentInFlight || String.isEmpty comment then - model => Cmd.none - else - let - cmdFromAuth authToken = - authToken - |> Request.Article.Comments.post model.article.slug comment - |> Http.send CommentPosted - in - session - |> Session.attempt "post a comment" cmdFromAuth - |> Tuple.mapFirst (Util.appendErrors { model | commentInFlight = True }) - - CommentPosted (Ok comment) -> - { model - | commentInFlight = False - , comments = comment :: model.comments - } - => Cmd.none - CommentPosted (Err error) -> - { model | errors = model.errors ++ [ "Server error while trying to post comment." ] } - => Cmd.none +-- HTTP - DeleteComment id -> - let - cmdFromAuth authToken = - authToken - |> Request.Article.Comments.delete model.article.slug id - |> Http.send (CommentDeleted id) - in - session - |> Session.attempt "delete comments" cmdFromAuth - |> Tuple.mapFirst (Util.appendErrors model) - CommentDeleted id (Ok ()) -> - { model | comments = withoutComment id model.comments } - => Cmd.none +delete : Slug -> Cred -> Http.Request () +delete slug cred = + Api.delete (Endpoint.article slug) cred Http.emptyBody (Decode.succeed ()) - CommentDeleted id (Err error) -> - { model | errors = model.errors ++ [ "Server error while trying to delete comment." ] } - => Cmd.none - DeleteArticle -> - let - cmdFromAuth authToken = - authToken - |> Request.Article.delete model.article.slug - |> Http.send ArticleDeleted - in - session - |> Session.attempt "delete articles" cmdFromAuth - |> Tuple.mapFirst (Util.appendErrors model) - ArticleDeleted (Ok ()) -> - model => Route.modifyUrl Route.Home +-- EXPORT + - ArticleDeleted (Err error) -> - { model | errors = model.errors ++ [ "Server error while trying to delete article." ] } - => Cmd.none +toSession : Model -> Session +toSession model = + model.session --- INTERNAL -- +-- 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.filter (\comment -> comment.id /= id) +withoutComment id list = + List.filter (\comment -> Comment.id comment /= id) list -favoriteButton : Article a -> Html Msg -favoriteButton article = +favoriteButton : Cred -> Article Full -> Html Msg +favoriteButton cred article = let - favoriteText = - " Favorite Article (" ++ toString article.favoritesCount ++ ")" + { favoritesCount, favorited } = + Article.metadata article + + slug = + Article.slug article + + body = + Article.body article + + kids = + [ text (" Favorite Article (" ++ String.fromInt favoritesCount ++ ")") ] in - Favorite.button (\_ -> ToggleFavorite) article [] [ text favoriteText ] + if favorited then + Article.unfavoriteButton cred (ClickedUnfavorite cred slug body) [] kids + else + Article.favoriteButton cred (ClickedFavorite cred slug body) [] kids -deleteButton : Article a -> Html Msg -deleteButton article = - button [ class "btn btn-outline-danger btn-sm", onClick DeleteArticle ] + +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) ] + a [ class "btn btn-outline-secondary btn-sm", Route.href (Route.EditArticle (Article.slug article)) ] [ i [ class "ion-edit" ] [], text " Edit Article" ] - - -followButton : Follow.State record -> Html Msg -followButton = - Follow.button (\_ -> ToggleFollow) diff --git a/src/Page/Article/Editor.elm b/src/Page/Article/Editor.elm index b59bb2f050..d339cbfd26 100644 --- a/src/Page/Article/Editor.elm +++ b/src/Page/Article/Editor.elm @@ -1,242 +1,600 @@ -module Page.Article.Editor exposing (Model, Msg, initEdit, initNew, update, view) - -import Data.Article as Article exposing (Article, Body) -import Data.Session exposing (Session) -import Data.User exposing (User) +module Page.Article.Editor exposing (Model, Msg, initEdit, initNew, subscriptions, toSession, update, view) + +import Api exposing (Cred) +import Api.Endpoint as Endpoint +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, defaultValue, disabled, href, id, placeholder, type_) +import Html.Attributes exposing (attribute, class, disabled, href, id, placeholder, type_, value) import Html.Events exposing (onInput, onSubmit) import Http -import Page.Errored exposing (PageLoadError, pageLoadError) -import Request.Article +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 Util exposing ((=>), pair, viewIf) -import Validate exposing (Validator, ifBlank, validate) -import Views.Form as Form -import Views.Page as Page +import Time + --- MODEL -- +-- MODEL type alias Model = - { errors : List Error - , editingArticle : Maybe Article.Slug - , title : String + { 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 : List String - , isSaving : Bool + , tags : String } -initNew : Model -initNew = - { errors = [] - , editingArticle = Nothing - , title = "" - , body = "" - , description = "" - , tags = [] - , isSaving = False - } +initNew : Session -> ( Model, Cmd msg ) +initNew session = + ( { session = session + , status = + EditingNew [] + { title = "" + , body = "" + , description = "" + , tags = "" + } + } + , Cmd.none + ) -initEdit : Session -> Article.Slug -> Task PageLoadError Model +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 - maybeAuthToken = - session.user - |> Maybe.map .token + errorMessage = + case problem of + InvalidEntry _ message -> + message + + ServerError message -> + message in - Request.Article.get maybeAuthToken slug - |> Http.toTask - |> Task.mapError (\_ -> pageLoadError Page.Other "Article is currently unavailable.") - |> Task.map - (\article -> - { errors = [] - , editingArticle = Just slug - , title = article.title - , body = Article.bodyToMarkdownString article.body - , description = article.description - , tags = article.tags - , isSaving = False - } - ) + li [] [ text errorMessage ] +viewAuthenticated : Cred -> Model -> Html Msg +viewAuthenticated cred model = + let + formHtml = + case model.status of + Loading _ -> + [] --- VIEW -- + LoadingSlowly _ -> + [ Loading.icon ] + Saving slug form -> + [ viewForm cred form (editArticleSaveButton [ disabled True ]) ] -view : Model -> Html Msg -view model = + 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" ] - [ Form.viewErrors model.errors - , viewForm model - ] + formHtml ] ] ] -viewForm : Model -> Html Msg -viewForm model = - let - isEditing = - model.editingArticle /= Nothing - - saveButtonText = - if isEditing then - "Update Article" - else - "Publish Article" - in - Html.form [ onSubmit Save ] +viewForm : Cred -> Form -> Html Msg -> Html Msg +viewForm cred fields saveButton = + Html.form [ onSubmit (ClickedSave cred) ] [ fieldset [] - [ Form.input - [ class "form-control-lg" - , placeholder "Article Title" - , onInput SetTitle - , defaultValue model.title + [ fieldset [ class "form-group" ] + [ input + [ class "form-control form-control-lg" + , placeholder "Article Title" + , onInput EnteredTitle + , value fields.title + ] + [] ] - [] - , Form.input - [ placeholder "What's this article about?" - , onInput SetDescription - , defaultValue model.description + , fieldset [ class "form-group" ] + [ input + [ class "form-control" + , placeholder "What's this article about?" + , onInput EnteredDescription + , value fields.description + ] + [] ] - [] - , Form.textarea - [ placeholder "Write your article (in markdown)" - , attribute "rows" "8" - , onInput SetBody - , defaultValue model.body + , fieldset [ class "form-group" ] + [ textarea + [ class "form-control" + , placeholder "Write your article (in markdown)" + , attribute "rows" "8" + , onInput EnteredBody + , value fields.body + ] + [] ] - [] - , Form.input - [ placeholder "Enter tags" - , onInput SetTags - , defaultValue (String.join " " model.tags) + , fieldset [ class "form-group" ] + [ input + [ class "form-control" + , placeholder "Enter tags" + , onInput EnteredTags + , value fields.tags + ] + [] ] - [] - , button [ class "btn btn-lg pull-xs-right btn-primary", disabled model.isSaving ] - [ text saveButtonText ] + , saveButton ] ] +editArticleSaveButton : List (Attribute msg) -> Html msg +editArticleSaveButton extraAttrs = + saveArticleButton "Update Article" extraAttrs --- UPDATE -- + +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 ] -type Msg - = Save - | SetTitle String - | SetDescription String - | SetTags String - | SetBody String - | CreateCompleted (Result Http.Error (Article Body)) - | EditCompleted (Result Http.Error (Article Body)) +-- UPDATE -update : User -> Msg -> Model -> ( Model, Cmd Msg ) -update user msg model = + +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 - Save -> - case validate modelValidator model of - [] -> - case model.editingArticle of - Nothing -> - user.token - |> Request.Article.create model - |> Http.send CreateCompleted - |> pair { model | errors = [], isSaving = True } + 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 - Just slug -> - user.token - |> Request.Article.update slug model - |> Http.send EditCompleted - |> pair { model | errors = [], isSaving = True } + EnteredTags tags -> + updateForm (\form -> { form | tags = tags }) model - errors -> - { model | errors = errors } => Cmd.none + EnteredBody body -> + updateForm (\form -> { form | body = body }) model - SetTitle title -> - { model | title = title } => Cmd.none + 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 + ) - SetDescription description -> - { model | description = description } => Cmd.none + CompletedEdit (Ok article) -> + ( model + , Route.Article (Article.slug article) + |> Route.replaceUrl (Session.navKey model.session) + ) - SetTags tags -> - { model | tags = tagsFromString tags } => Cmd.none + CompletedEdit (Err error) -> + ( { model | status = savingError error model.status } + , Cmd.none + ) - SetBody body -> - { model | body = body } => Cmd.none + CompletedArticleLoad (Err ( slug, error )) -> + ( { model | status = LoadingFailed slug } + , Cmd.none + ) - CreateCompleted (Ok article) -> - Route.Article article.slug - |> Route.modifyUrl - |> pair model + 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 + ) - CreateCompleted (Err error) -> - { model - | errors = model.errors ++ [ Form => "Server error while attempting to publish article" ] - , isSaving = False - } - => Cmd.none + GotSession session -> + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) - EditCompleted (Ok article) -> - Route.Article article.slug - |> Route.modifyUrl - |> pair model + 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 - EditCompleted (Err error) -> - { model - | errors = model.errors ++ [ Form => "Server error while attempting to save article" ] - , isSaving = False - } - => Cmd.none + Creating form -> + EditingNew problems form + _ -> + status --- VALIDATION -- +{-| Helper function for `update`. Updates the form, if there is one, +and returns Cmd.none. +Useful for recording form fields! -type Field - = Form - | Title +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 -type alias Error = - ( Field, String ) +fieldsToValidate : List ValidatedField +fieldsToValidate = + [ Title + , Body + ] -modelValidator : Validator Error Model -modelValidator = - Validate.all - [ ifBlank .title (Title => "title can't be blank.") - , ifBlank .body (Body => "body can't be blank.") - ] +{-| 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 + [] --- INTERNAL -- +{-| 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 + 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) ) + ] + + body = + Encode.object [ ( "article", article ) ] + |> Http.jsonBody + in + Decode.field "article" (Article.fullDecoder (Just cred)) + |> Api.post (Endpoint.articles []) (Just cred) body tagsFromString : String -> List String tagsFromString str = - str - |> String.split " " + String.split " " str |> List.map String.trim |> List.filter (not << String.isEmpty) -redirectToArticle : Article.Slug -> Cmd msg -redirectToArticle = - Route.modifyUrl << Route.Article +edit : Slug -> TrimmedForm -> Cred -> Http.Request (Article Full) +edit articleSlug (Trimmed form) cred = + let + article = + Encode.object + [ ( "title", Encode.string form.title ) + , ( "description", Encode.string form.description ) + , ( "body", Encode.string form.body ) + ] + + body = + Encode.object [ ( "article", article ) ] + |> Http.jsonBody + in + Decode.field "article" (Article.fullDecoder (Just cred)) + |> Api.put (Endpoint.article articleSlug) cred body + + + +-- 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 diff --git a/src/Page/Blank.elm b/src/Page/Blank.elm new file mode 100644 index 0000000000..3ae45a3480 --- /dev/null +++ b/src/Page/Blank.elm @@ -0,0 +1,10 @@ +module Page.Blank exposing (view) + +import Html exposing (Html) + + +view : { title : String, content : Html msg } +view = + { title = "" + , content = Html.text "" + } diff --git a/src/Page/Errored.elm b/src/Page/Errored.elm deleted file mode 100644 index f90dcda4c8..0000000000 --- a/src/Page/Errored.elm +++ /dev/null @@ -1,45 +0,0 @@ -module Page.Errored exposing (PageLoadError, pageLoadError, view) - -{-| The page that renders when there was an error trying to load another page, -for example a Page Not Found error. - -It includes a photo I took of a painting on a building in San Francisco, -of a giant walrus exploding the golden gate bridge with laser beams. Pew pew! - --} - -import Data.Session exposing (Session) -import Html exposing (Html, div, h1, img, main_, p, text) -import Html.Attributes exposing (alt, class, id, tabindex) -import Views.Page exposing (ActivePage) - - --- MODEL -- - - -type PageLoadError - = PageLoadError Model - - -type alias Model = - { activePage : ActivePage - , errorMessage : String - } - - -pageLoadError : ActivePage -> String -> PageLoadError -pageLoadError activePage errorMessage = - PageLoadError { activePage = activePage, errorMessage = errorMessage } - - - --- VIEW -- - - -view : Session -> PageLoadError -> Html msg -view session (PageLoadError model) = - main_ [ id "content", class "container", tabindex -1 ] - [ h1 [] [ text "Error Loading Page" ] - , div [ class "row" ] - [ p [] [ text model.errorMessage ] ] - ] diff --git a/src/Page/Home.elm b/src/Page/Home.elm index 548afb77a2..9008a8311c 100644 --- a/src/Page/Home.elm +++ b/src/Page/Home.elm @@ -1,75 +1,146 @@ -module Page.Home exposing (Model, Msg, init, update, view) +module Page.Home exposing (Model, Msg, init, subscriptions, toSession, update, view) {-| The homepage. You can get here via either the / or /#/ routes. -} -import Data.Article as Article exposing (Tag) -import Data.Session exposing (Session) +import Api exposing (Cred) +import Api.Endpoint as Endpoint +import Article exposing (Article, Preview) +import Article.Feed as Feed +import Article.Tag as Tag exposing (Tag) +import Browser.Dom as Dom import Html exposing (..) import Html.Attributes exposing (attribute, class, classList, href, id, placeholder) import Html.Events exposing (onClick) import Http -import Page.Errored exposing (PageLoadError, pageLoadError) -import Request.Article -import SelectList exposing (SelectList) +import Loading +import Log +import Page +import PaginatedList exposing (PaginatedList) +import Session exposing (Session) import Task exposing (Task) -import Util exposing ((=>), onClickStopPropagation) -import Views.Article.Feed as Feed exposing (FeedSource, globalFeed, tagFeed, yourFeed) -import Views.Page as Page +import Time +import Url.Builder +import Username exposing (Username) --- MODEL -- + +-- MODEL type alias Model = - { tags : List Tag - , feed : Feed.Model + { session : Session + , timeZone : Time.Zone + , feedTab : FeedTab + , feedPage : Int + + -- Loaded independently from server + , tags : Status (List Tag) + , feed : Status Feed.Model } -init : Session -> Task PageLoadError Model -init session = - let - feedSources = - if session.user == Nothing then - SelectList.singleton globalFeed - else - SelectList.fromLists [] yourFeed [ globalFeed ] - - loadTags = - Request.Article.tags - |> Http.toTask - - loadSources = - Feed.init session feedSources +type Status a + = Loading + | LoadingSlowly + | Loaded a + | Failed - handleLoadError _ = - pageLoadError Page.Home "Homepage is currently unavailable." - in - Task.map2 Model loadTags loadSources - |> Task.mapError handleLoadError +type FeedTab + = YourFeed Cred + | GlobalFeed + | TagFeed Tag --- VIEW -- +init : Session -> ( Model, Cmd Msg ) +init session = + let + feedTab = + case Session.cred session of + Just cred -> + YourFeed cred + Nothing -> + GlobalFeed -view : Session -> Model -> Html Msg -view session model = - div [ class "home-page" ] - [ viewBanner - , div [ class "container page" ] - [ div [ class "row" ] - [ div [ class "col-md-9" ] (viewFeed model.feed) - , div [ class "col-md-3" ] - [ div [ class "sidebar" ] - [ p [] [ text "Popular Tags" ] - , viewTags model.tags - ] + loadTags = + Http.toTask Tag.list + in + ( { session = session + , timeZone = Time.utc + , feedTab = feedTab + , feedPage = 1 + , tags = Loading + , feed = Loading + } + , Cmd.batch + [ fetchFeed session feedTab 1 + |> 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 -> + [ div [ class "feed-toggle" ] <| + List.concat + [ [ viewTabs + (Session.cred model.session) + model.feedTab + ] + , Feed.viewArticles model.timeZone feed + |> List.map (Html.map GotFeedMsg) + , [ Feed.viewPagination ClickedFeedPage model.feedPage 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 @@ -82,11 +153,58 @@ viewBanner = ] -viewFeed : Feed.Model -> List (Html Msg) -viewFeed feed = - div [ class "feed-toggle" ] - [ Feed.viewFeedSources feed |> Html.map FeedMsg ] - :: (Feed.viewArticles feed |> List.map (Html.map FeedMsg)) + +-- TABS + + +viewTabs : Maybe Cred -> FeedTab -> Html Msg +viewTabs maybeCred tab = + case tab of + YourFeed cred -> + Feed.viewTabs [] (yourFeed cred) [ globalFeed ] + + GlobalFeed -> + let + otherTabs = + case maybeCred of + Just cred -> + [ yourFeed cred ] + + Nothing -> + [] + in + Feed.viewTabs otherTabs globalFeed [] + + TagFeed tag -> + let + otherTabs = + case maybeCred of + Just cred -> + [ yourFeed cred, globalFeed ] + + Nothing -> + [ globalFeed ] + in + Feed.viewTabs otherTabs (tagFeed tag) [] + + +yourFeed : Cred -> ( String, Msg ) +yourFeed cred = + ( "Your Feed", ClickedTab (YourFeed cred) ) + + +globalFeed : ( String, Msg ) +globalFeed = + ( "Global Feed", ClickedTab GlobalFeed ) + + +tagFeed : Tag -> ( String, Msg ) +tagFeed tag = + ( "#" ++ Tag.toString tag, ClickedTab (TagFeed tag) ) + + + +-- TAGS viewTags : List Tag -> Html Msg @@ -98,34 +216,180 @@ viewTag : Tag -> Html Msg viewTag tagName = a [ class "tag-pill tag-default" - , href "javascript:void(0)" - , onClick (SelectTag tagName) + , onClick (ClickedTag tagName) + + -- The RealWorld CSS requires an href to work properly. + , href "" ] - [ text (Article.tagToString tagName) ] + [ text (Tag.toString tagName) ] --- UPDATE -- +-- UPDATE type Msg - = FeedMsg Feed.Msg - | SelectTag Tag - - -update : Session -> Msg -> Model -> ( Model, Cmd Msg ) -update session msg model = + = ClickedTag Tag + | ClickedTab FeedTab + | ClickedFeedPage Int + | 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 - FeedMsg subMsg -> + ClickedTag tag -> let - ( newFeed, subCmd ) = - Feed.update session subMsg model.feed + feedTab = + TagFeed tag in - { model | feed = newFeed } => Cmd.map FeedMsg subCmd - - SelectTag tagName -> + ( { model | feedTab = feedTab } + , fetchFeed model.session feedTab 1 + |> Task.attempt CompletedFeedLoad + ) + + ClickedTab tab -> + ( { model | feedTab = tab } + , fetchFeed model.session tab 1 + |> Task.attempt CompletedFeedLoad + ) + + ClickedFeedPage page -> + ( { model | feedPage = page } + , fetchFeed model.session model.feedTab page + |> Task.andThen (\feed -> Task.map (\_ -> feed) scrollToTop) + |> Task.attempt CompletedFeedLoad + ) + + 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 - subCmd = - Feed.selectTag (Maybe.map .token session.user) tagName + -- 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 => Cmd.map FeedMsg subCmd + ( { model | feed = feed, tags = tags }, Cmd.none ) + + + +-- HTTP + + +fetchFeed : Session -> FeedTab -> Int -> Task Http.Error Feed.Model +fetchFeed session feedTabs page = + let + maybeCred = + Session.cred session + + decoder = + Feed.decoder maybeCred articlesPerPage + + params = + PaginatedList.params { page = page, resultsPerPage = articlesPerPage } + + request = + case feedTabs of + YourFeed cred -> + Api.get (Endpoint.feed params) maybeCred decoder + + GlobalFeed -> + Api.get (Endpoint.articles params) maybeCred decoder + + TagFeed tag -> + let + firstParam = + Url.Builder.string "tag" (Tag.toString tag) + in + Api.get (Endpoint.articles (firstParam :: params)) maybeCred decoder + in + Http.toTask request + |> Task.map (Feed.init session) + + +articlesPerPage : Int +articlesPerPage = + 10 + + +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 ()) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Session.changes GotSession (Session.navKey model.session) + + + +-- EXPORT + + +toSession : Model -> Session +toSession model = + model.session diff --git a/src/Page/Login.elm b/src/Page/Login.elm index 1dd3ad1176..31bab51450 100644 --- a/src/Page/Login.elm +++ b/src/Page/Login.elm @@ -1,203 +1,315 @@ -module Page.Login exposing (ExternalMsg(..), Model, Msg, initialModel, update, view) +module Page.Login exposing (Model, Msg, init, subscriptions, toSession, update, view) {-| The login page. -} -import Data.Session exposing (Session) -import Data.User exposing (User) +import Api exposing (Cred) +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 (decode, optional) -import Request.User exposing (storeSession) +import Json.Decode.Pipeline exposing (optional) +import Json.Encode as Encode import Route exposing (Route) -import Util exposing ((=>)) -import Validate exposing (Validator, ifBlank, validate) -import Views.Form as Form +import Session exposing (Session) +import Viewer exposing (Viewer) --- MODEL -- + +-- MODEL type alias Model = - { errors : List Error - , email : String - , password : String + { session : Session + , problems : List Problem + , form : Form } -initialModel : Model -initialModel = - { errors = [] - , email = "" - , password = "" - } +{-| 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 --- VIEW -- +type alias Form = + { email : String + , password : String + } -view : Session -> Model -> Html Msg -view session model = - div [ class "auth-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?" ] +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 ] - , Form.viewErrors model.errors - , viewForm ] ] ] - ] + } -viewForm : Html Msg -viewForm = - Html.form [ onSubmit SubmitForm ] - [ Form.input - [ class "form-control-lg" - , placeholder "Email" - , onInput SetEmail +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 + ] + [] ] - [] - , Form.password - [ class "form-control-lg" - , placeholder "Password" - , onInput SetPassword + , 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 -- +-- UPDATE type Msg - = SubmitForm - | SetEmail String - | SetPassword String - | LoginCompleted (Result Http.Error User) - + = SubmittedForm + | EnteredEmail String + | EnteredPassword String + | CompletedLogin (Result Http.Error Viewer) + | GotSession Session -type ExternalMsg - = NoOp - | SetUser User - -update : Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg ) +update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of - SubmitForm -> - case validate modelValidator model of - [] -> - { model | errors = [] } - => Http.send LoginCompleted (Request.User.login model) - => NoOp - - errors -> - { model | errors = errors } - => Cmd.none - => NoOp - - SetEmail email -> - { model | email = email } - => Cmd.none - => NoOp - - SetPassword password -> - { model | password = password } - => Cmd.none - => NoOp - - LoginCompleted (Err error) -> + 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 - errorMessages = - case error of - Http.BadStatus response -> - response.body - |> decodeString (field "errors" errorsDecoder) - |> Result.withDefault [] - - _ -> - [ "unable to perform login" ] + serverErrors = + Api.decodeErrors error + |> List.map ServerError in - { model | errors = List.map (\errorMessage -> Form => errorMessage) errorMessages } - => Cmd.none - => NoOp + ( { model | problems = List.append model.problems serverErrors } + , Cmd.none + ) + + CompletedLogin (Ok viewer) -> + ( model + , Viewer.store viewer + ) - LoginCompleted (Ok user) -> - model - => Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ] - => SetUser user + GotSession session -> + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) +{-| Helper function for `update`. Updates the form and returns Cmd.none. +Useful for recording form fields! +-} +updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg ) +updateForm transform model = + ( { model | form = transform model.form }, Cmd.none ) --- VALIDATION -- -type Field - = Form - | Email - | Password +-- SUBSCRIPTIONS -{-| Recording validation errors on a per-field basis facilitates displaying -them inline next to the field where the error occurred. +subscriptions : Model -> Sub Msg +subscriptions model = + Session.changes GotSession (Session.navKey model.session) -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: -viewFormErrors : Field -> List Error -> Html msg +-- FORM -...and it filters the list of errors to render only the ones for the given -Field. This way you can call this: -viewFormErrors Email model.errors +{-| 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 -...next to the `email` field, and call `viewFormErrors Password model.errors` -next to the `password` field, and so on. +{-| When adding a variant here, add it to `fieldsToValidate` too! -} -type alias Error = - ( Field, String ) +type ValidatedField + = Email + | Password -modelValidator : Validator Error Model -modelValidator = - Validate.all - [ ifBlank .email (Email => "email can't be blank.") - , ifBlank .password (Password => "password can't be blank.") - ] +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 -errorsDecoder : Decoder (List String) -errorsDecoder = - decode (\emailOrPassword email username password -> List.concat [ emailOrPassword, email, username, password ]) - |> optionalError "email or password" - |> optionalError "email" - |> optionalError "username" - |> optionalError "password" +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." ] -optionalError : String -> Decoder (List String -> a) -> Decoder a -optionalError fieldName = + 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 - errorToString errorMessage = - String.join " " [ fieldName, errorMessage ] + user = + Encode.object + [ ( "email", Encode.string form.email ) + , ( "password", Encode.string form.password ) + ] + + body = + Encode.object [ ( "user", user ) ] + |> Http.jsonBody in - optional fieldName (Decode.list (Decode.map errorToString string)) [] + Api.login body Viewer.decoder + + + +-- EXPORT + + +toSession : Model -> Session +toSession model = + model.session diff --git a/src/Page/NotFound.elm b/src/Page/NotFound.elm index a1a76457df..e0c534b732 100644 --- a/src/Page/NotFound.elm +++ b/src/Page/NotFound.elm @@ -1,18 +1,21 @@ module Page.NotFound exposing (view) -import Data.Session exposing (Session) +import Asset import Html exposing (Html, div, h1, img, main_, text) import Html.Attributes exposing (alt, class, id, src, tabindex) -import Views.Assets as Assets --- VIEW -- +-- VIEW -view : Session -> Html msg -view session = - main_ [ id "content", class "container", tabindex -1 ] - [ h1 [] [ text "Not Found" ] - , div [ class "row" ] - [ img [ Assets.src Assets.error, alt "giant laser walrus wreaking havoc" ] [] ] - ] + +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 ] [] ] + ] + } diff --git a/src/Page/Profile.elm b/src/Page/Profile.elm index e5c4cef5f7..906b5270d2 100644 --- a/src/Page/Profile.elm +++ b/src/Page/Profile.elm @@ -1,167 +1,438 @@ -module Page.Profile exposing (Model, Msg, init, update, view) +module Page.Profile exposing (Model, Msg, init, subscriptions, toSession, update, view) -{-| Viewing a user's profile. +{-| An Author's profile. -} -import Data.Profile exposing (Profile) -import Data.Session exposing (Session) -import Data.User as User exposing (Username) -import Data.UserPhoto as UserPhoto exposing (UserPhoto) +import Api exposing (Cred) +import Api.Endpoint as Endpoint +import Article exposing (Article, Preview) +import Article.Feed as Feed +import Author exposing (Author(..), FollowedAuthor, UnfollowedAuthor) +import Avatar exposing (Avatar) import Html exposing (..) import Html.Attributes exposing (..) import Http -import Page.Errored exposing (PageLoadError, pageLoadError) -import Request.Article exposing (ListConfig, defaultListConfig) -import Request.Profile -import SelectList exposing (SelectList) +import Loading +import Log +import Page +import PaginatedList exposing (PaginatedList) +import Profile exposing (Profile) +import Route +import Session exposing (Session) import Task exposing (Task) -import Util exposing ((=>), pair, viewIf) -import Views.Article.Feed as Feed exposing (FeedSource, authorFeed, favoritedFeed) -import Views.Errors as Errors -import Views.Page as Page -import Views.User.Follow as Follow +import Time +import Url.Builder +import Username exposing (Username) +import Viewer exposing (Viewer) --- MODEL -- + +-- MODEL type alias Model = - { errors : List String - , profile : Profile - , feed : Feed.Model + { session : Session + , timeZone : Time.Zone + , errors : List String + , feedTab : FeedTab + , feedPage : Int + + -- Loaded independently from server + , author : Status Author + , feed : Status Feed.Model } -init : Session -> Username -> Task PageLoadError Model +type FeedTab + = MyArticles + | FavoritedArticles + + +type Status a + = Loading Username + | LoadingSlowly Username + | Loaded a + | Failed Username + + +init : Session -> Username -> ( Model, Cmd Msg ) init session username = let - config : ListConfig - config = - { defaultListConfig | limit = 5, author = Just username } + maybeCred = + Session.cred session + in + ( { session = session + , timeZone = Time.utc + , errors = [] + , feedTab = defaultFeedTab + , feedPage = 1 + , author = Loading username + , feed = Loading username + } + , Cmd.batch + [ Author.fetch username maybeCred + |> Http.toTask + |> Task.mapError (Tuple.pair username) + |> Task.attempt CompletedAuthorLoad + , fetchFeed session defaultFeedTab username 1 + , Task.perform GotTimeZone Time.here + , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold + ] + ) - maybeAuthToken = - session.user - |> Maybe.map .token - loadProfile = - Request.Profile.get username maybeAuthToken - |> Http.toTask +currentUsername : Model -> Username +currentUsername model = + case model.author of + Loading username -> + username - loadFeedSources = - Feed.init session (defaultFeedSources username) + LoadingSlowly username -> + username - handleLoadError _ = - "Profile is currently unavailable." - |> pageLoadError (Page.Profile username) - in - Task.map2 (Model []) loadProfile loadFeedSources - |> Task.mapError handleLoadError + Loaded author -> + Author.username author + + Failed username -> + username + + +defaultFeedTab : FeedTab +defaultFeedTab = + MyArticles --- VIEW -- +-- HTTP -view : Session -> Model -> Html Msg -view session model = +fetchFeed : Session -> FeedTab -> Username -> Int -> Cmd Msg +fetchFeed session feedTabs username page = let - profile = - model.profile + maybeCred = + Session.cred session + + firstParam = + case feedTabs of + MyArticles -> + Url.Builder.string "author" (Username.toString username) + + FavoritedArticles -> + Url.Builder.string "favorited" (Username.toString username) + + params = + firstParam :: PaginatedList.params { page = page, resultsPerPage = articlesPerPage } - isMyProfile = - session.user - |> Maybe.map (\{ username } -> username == profile.username) - |> Maybe.withDefault False + expect = + Feed.decoder maybeCred articlesPerPage in - div [ class "profile-page" ] - [ Errors.view DismissErrors model.errors - , div [ class "user-info" ] - [ div [ class "container" ] - [ div [ class "row" ] - [ viewProfileInfo isMyProfile profile ] - ] - ] - , div [ class "container" ] - [ div [ class "row" ] [ viewFeed model.feed ] ] - ] + Api.get (Endpoint.articles params) maybeCred expect + |> Http.toTask + |> Task.map (Feed.init session) + |> Task.mapError (Tuple.pair username) + |> Task.attempt CompletedFeedLoad -viewProfileInfo : Bool -> Profile -> Html Msg -viewProfileInfo isMyProfile profile = - div [ class "col-xs-12 col-md-10 offset-md-1" ] - [ img [ class "user-img", UserPhoto.src profile.image ] [] - , h4 [] [ User.usernameToHtml profile.username ] - , p [] [ text (Maybe.withDefault "" profile.bio) ] - , viewIf (not isMyProfile) (followButton profile) - ] +articlesPerPage : Int +articlesPerPage = + 5 -viewFeed : Feed.Model -> Html Msg -viewFeed feed = - div [ class "col-xs-12 col-md-10 offset-md-1" ] <| - div [ class "articles-toggle" ] - [ Feed.viewFeedSources feed |> Html.map FeedMsg ] - :: (Feed.viewArticles feed |> List.map (Html.map FeedMsg)) +-- VIEW --- UPDATE -- +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) -type Msg - = DismissErrors - | ToggleFollow - | FollowCompleted (Result Http.Error Profile) - | FeedMsg Feed.Msg + Loaded ((IsNotFollowing unfollowedAuthor) as author) -> + titleForOther (Author.username author) + Loading username -> + titleForMe (Session.cred model.session) username -update : Session -> Msg -> Model -> ( Model, Cmd Msg ) -update session msg model = - let - profile = - model.profile + 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" ] + [ div [ class "col-xs-12 col-md-10 offset-md-1" ] + [ div [ class "articles-toggle" ] <| + List.concat + [ [ viewTabs model.feedTab ] + , Feed.viewArticles model.timeZone feed + |> List.map (Html.map GotFeedMsg) + , [ Feed.viewPagination ClickedFeedPage model.feedPage 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 == Api.username cred then + myProfileTitle + + else + defaultTitle + + Nothing -> + defaultTitle + + +myProfileTitle : String +myProfileTitle = + "My Profile" + + +defaultTitle : String +defaultTitle = + "Profile" + + + +-- TABS + + +viewTabs : FeedTab -> Html Msg +viewTabs tab = + case tab of + MyArticles -> + Feed.viewTabs [] myArticles [ favoritedArticles ] + + FavoritedArticles -> + Feed.viewTabs [ myArticles ] favoritedArticles [] + + +myArticles : ( String, Msg ) +myArticles = + ( "My Articles", ClickedTab MyArticles ) + + +favoritedArticles : ( String, Msg ) +favoritedArticles = + ( "Favorited Articles", ClickedTab FavoritedArticles ) + + + +-- UPDATE + + +type Msg + = ClickedDismissErrors + | ClickedFollow Cred UnfollowedAuthor + | ClickedUnfollow Cred FollowedAuthor + | ClickedTab FeedTab + | ClickedFeedPage Int + | 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 - DismissErrors -> - { model | errors = [] } => Cmd.none - - ToggleFollow -> - case session.user of - Nothing -> - { model | errors = model.errors ++ [ "You are currently signed out. You must be signed in to follow people." ] } - => Cmd.none - - Just user -> - user.token - |> Request.Profile.toggleFollow - profile.username - profile.following - |> Http.send FollowCompleted - |> pair model - - FollowCompleted (Ok newProfile) -> - { model | profile = newProfile } => Cmd.none - - FollowCompleted (Err error) -> - model => Cmd.none - - FeedMsg subMsg -> + 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 + ) + + ClickedTab tab -> + ( { model | feedTab = tab } + , fetchFeed model.session tab (currentUsername model) 1 + ) + + ClickedFeedPage page -> + ( { model | feedPage = page } + , fetchFeed model.session model.feedTab (currentUsername model) page + ) + + 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 - ( newFeed, subCmd ) = - Feed.update session subMsg model.feed + -- 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 = newFeed } => Cmd.map FeedMsg subCmd + ( { model | feed = feed }, Cmd.none ) + + + +-- SUBSCRIPTIONS -followButton : Profile -> Html Msg -followButton = - Follow.button (\_ -> ToggleFollow) +subscriptions : Model -> Sub Msg +subscriptions model = + Session.changes GotSession (Session.navKey model.session) --- INTERNAL -- +-- EXPORT -defaultFeedSources : Username -> SelectList FeedSource -defaultFeedSources username = - SelectList.fromLists [] (authorFeed username) [ favoritedFeed username ] +toSession : Model -> Session +toSession model = + model.session diff --git a/src/Page/Register.elm b/src/Page/Register.elm index 3dd5f3cace..f1078e9329 100644 --- a/src/Page/Register.elm +++ b/src/Page/Register.elm @@ -1,194 +1,317 @@ -module Page.Register exposing (ExternalMsg(..), Model, Msg, initialModel, update, view) +module Page.Register exposing (Model, Msg, init, subscriptions, toSession, update, view) -import Data.Session exposing (Session) -import Data.User exposing (User) +import Api exposing (Cred) +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 (decode, optional) -import Request.User exposing (storeSession) +import Json.Decode.Pipeline exposing (optional) +import Json.Encode as Encode import Route exposing (Route) -import Util exposing ((=>)) -import Validate exposing (Validator, ifBlank, validate) -import Views.Form as Form +import Session exposing (Session) +import Viewer exposing (Viewer) --- MODEL -- + +-- MODEL type alias Model = - { errors : List Error - , email : String - , username : String - , password : String + { session : Session + , problems : List Problem + , form : Form } -initialModel : Model -initialModel = - { errors = [] - , email = "" - , username = "" - , password = "" +type alias Form = + { email : String + , username : String + , password : String } - --- VIEW -- - - -view : Session -> Model -> Html Msg -view session model = - div [ class "auth-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?" ] +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 ] - , Form.viewErrors model.errors - , viewForm ] ] ] - ] + } -viewForm : Html Msg -viewForm = - Html.form [ onSubmit SubmitForm ] - [ Form.input - [ class "form-control-lg" - , placeholder "Username" - , onInput SetUsername +viewForm : Form -> Html Msg +viewForm form = + Html.form [ onSubmit SubmittedForm ] + [ fieldset [ class "form-group" ] + [ input + [ class "form-control form-control-lg" + , placeholder "Username" + , onInput EnteredUsername + , value form.username + ] + [] ] - [] - , Form.input - [ class "form-control-lg" - , placeholder "Email" - , onInput SetEmail + , fieldset [ class "form-group" ] + [ input + [ class "form-control form-control-lg" + , placeholder "Email" + , onInput EnteredEmail + , value form.email + ] + [] ] - [] - , Form.password - [ class "form-control-lg" - , placeholder "Password" - , onInput SetPassword + , 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 - = SubmitForm - | SetEmail String - | SetUsername String - | SetPassword String - | RegisterCompleted (Result Http.Error User) +-- UPDATE -type ExternalMsg - = NoOp - | SetUser User +type Msg + = SubmittedForm + | EnteredEmail String + | EnteredUsername String + | EnteredPassword String + | CompletedRegister (Result Http.Error Viewer) + | GotSession Session -update : Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg ) +update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of - SubmitForm -> - case validate modelValidator model of - [] -> - { model | errors = [] } - => Http.send RegisterCompleted (Request.User.register model) - => NoOp - - errors -> - { model | errors = errors } - => Cmd.none - => NoOp - - SetEmail email -> - { model | email = email } - => Cmd.none - => NoOp - - SetUsername username -> - { model | username = username } - => Cmd.none - => NoOp - - SetPassword password -> - { model | password = password } - => Cmd.none - => NoOp - - RegisterCompleted (Err error) -> + SubmittedForm -> + case validate model.form of + Ok validForm -> + ( { model | problems = [] } + , Http.send CompletedRegister (register validForm) + ) + + Err problems -> + ( { model | problems = problems } + , Cmd.none + ) + + EnteredUsername username -> + updateForm (\form -> { form | username = username }) model + + EnteredEmail email -> + updateForm (\form -> { form | email = email }) model + + EnteredPassword password -> + updateForm (\form -> { form | password = password }) model + + CompletedRegister (Err error) -> let - errorMessages = - case error of - Http.BadStatus response -> - response.body - |> decodeString (field "errors" errorsDecoder) - |> Result.withDefault [] - - _ -> - [ "unable to process registration" ] + serverErrors = + Api.decodeErrors error + |> List.map ServerError in - { model | errors = List.map (\errorMessage -> Form => errorMessage) errorMessages } - => Cmd.none - => NoOp + ( { model | problems = List.append model.problems serverErrors } + , Cmd.none + ) + + CompletedRegister (Ok viewer) -> + ( model + , Viewer.store viewer + ) + + GotSession session -> + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) + + +{-| Helper function for `update`. Updates the form and returns Cmd.none. +Useful for recording form fields! +-} +updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg ) +updateForm transform model = + ( { model | form = transform model.form }, Cmd.none ) + - RegisterCompleted (Ok user) -> - model - => Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ] - => SetUser user +-- SUBSCRIPTIONS --- VALIDATION -- +subscriptions : Model -> Sub Msg +subscriptions model = + Session.changes GotSession (Session.navKey model.session) -type Field - = Form - | Username + +-- 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 -type alias Error = - ( Field, String ) +fieldsToValidate : List ValidatedField +fieldsToValidate = + [ Username + , Email + , Password + ] -modelValidator : Validator Error Model -modelValidator = - Validate.all - [ ifBlank .username (Username => "username can't be blank.") - , ifBlank .email (Email => "email can't be blank.") - , ifBlank .password (Password => "password can't be blank.") - ] +{-| 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 -errorsDecoder : Decoder (List String) -errorsDecoder = - decode (\email username password -> List.concat [ email, username, password ]) - |> optionalError "email" - |> optionalError "username" - |> optionalError "password" +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 + [] -optionalError : String -> Decoder (List String -> a) -> Decoder a -optionalError fieldName = + 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 - errorToString errorMessage = - String.join " " [ fieldName, errorMessage ] + 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 - optional fieldName (Decode.list (Decode.map errorToString string)) [] + Api.register body Viewer.decoder diff --git a/src/Page/Settings.elm b/src/Page/Settings.elm index 188f6cc804..dc188a905d 100644 --- a/src/Page/Settings.elm +++ b/src/Page/Settings.elm @@ -1,103 +1,185 @@ -module Page.Settings exposing (ExternalMsg(..), Model, Msg, init, update, view) - -import Data.Session exposing (Session) -import Data.User as User exposing (User) -import Data.UserPhoto as UserPhoto -import Html exposing (Html, button, div, fieldset, h1, input, text, textarea) -import Html.Attributes exposing (attribute, class, defaultValue, placeholder, type_) +module Page.Settings exposing (Model, Msg, init, subscriptions, toSession, update, view) + +import Api exposing (Cred) +import Api.Endpoint as Endpoint +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 Json.Decode as Decode exposing (Decoder, decodeString, field, list, string) -import Json.Decode.Pipeline exposing (decode, optional) -import Request.User exposing (storeSession) +import Json.Decode.Pipeline exposing (hardcoded, required) +import Json.Encode as Encode +import Loading +import Log +import Profile exposing (Profile) import Route -import Util exposing ((=>), pair) -import Validate exposing (Validator, ifBlank, validate) -import Views.Form as Form +import Session exposing (Session) +import Task +import Username as Username exposing (Username) +import Viewer exposing (Viewer) + --- MODEL -- +-- MODEL type alias Model = - { errors : List Error - , image : Maybe String - , email : String + { session : Session + , problems : List Problem + , status : Status + } + + +type alias Form = + { avatar : String , bio : String + , email : String , username : String - , password : Maybe String + , password : String } -init : User -> Model -init user = - { errors = [] - , image = UserPhoto.toMaybeString user.image - , email = user.email - , bio = Maybe.withDefault "" user.bio - , username = User.usernameToString user.username - , password = Nothing - } +type Status + = Loading + | LoadingSlowly + | Loaded Form + | Failed + + +type Problem + = InvalidEntry ValidatedField String + | ServerError String + + +init : Session -> ( Model, Cmd Msg ) +init session = + ( { session = session + , problems = [] + , status = Loading + } + , Cmd.batch + [ Api.get Endpoint.user (Session.cred session) (Decode.field "user" formDecoder) + |> Http.send CompletedFormLoad + , Task.perform (\_ -> PassedSlowLoadThreshold) Loading.slowThreshold + ] + ) + + +formDecoder : Decoder Form +formDecoder = + Decode.succeed Form + |> required "image" (Decode.map (Maybe.withDefault "") (Decode.nullable Decode.string)) + |> required "bio" (Decode.map (Maybe.withDefault "") (Decode.nullable Decode.string)) + |> required "email" Decode.string + |> required "username" Decode.string + |> hardcoded "" + + +{-| 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) + , case model.status of + Loaded form -> + viewForm cred form --- VIEW -- + Loading -> + text "" + LoadingSlowly -> + Loading.icon -view : Session -> Model -> Html Msg -view session model = - 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" ] - , Form.viewErrors model.errors - , viewForm model + Failed -> + text "Error loading page." + ] + ] + ] ] - ] - ] - ] + + Nothing -> + text "Sign in to view your settings." + } -viewForm : Model -> Html Msg -viewForm model = - Html.form [ onSubmit SubmitForm ] +viewForm : Cred -> Form -> Html Msg +viewForm cred form = + Html.form [ onSubmit (SubmittedForm cred form) ] [ fieldset [] - [ Form.input - [ placeholder "URL of profile picture" - , defaultValue (Maybe.withDefault "" model.image) - , onInput SetImage + [ fieldset [ class "form-group" ] + [ input + [ class "form-control" + , placeholder "URL of profile picture" + , value form.avatar + , onInput EnteredAvatar + ] + [] ] - [] - , Form.input - [ class "form-control-lg" - , placeholder "Username" - , defaultValue model.username - , onInput SetUsername + , fieldset [ class "form-group" ] + [ input + [ class "form-control form-control-lg" + , placeholder "Username" + , value form.username + , onInput EnteredUsername + ] + [] ] - [] - , Form.textarea - [ class "form-control-lg" - , placeholder "Short bio about you" - , attribute "rows" "8" - , defaultValue model.bio - , onInput SetBio + , fieldset [ class "form-group" ] + [ textarea + [ class "form-control form-control-lg" + , placeholder "Short bio about you" + , attribute "rows" "8" + , value form.bio + , onInput EnteredBio + ] + [] ] - [] - , Form.input - [ class "form-control-lg" - , placeholder "Email" - , defaultValue model.email - , onInput SetEmail + , fieldset [ class "form-group" ] + [ input + [ class "form-control form-control-lg" + , placeholder "Email" + , value form.email + , onInput EnteredEmail + ] + [] ] - [] - , Form.password - [ class "form-control-lg" - , placeholder "Password" - , defaultValue (Maybe.withDefault "" model.password) - , onInput SetPassword + , 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" ] @@ -105,145 +187,275 @@ viewForm model = ] +viewProblem : Problem -> Html msg +viewProblem problem = + let + errorMessage = + case problem of + InvalidEntry _ message -> + message + + ServerError message -> + message + in + li [] [ text errorMessage ] + --- UPDATE -- + +-- UPDATE type Msg - = SubmitForm - | SetEmail String - | SetUsername String - | SetPassword String - | SetBio String - | SetImage String - | SaveCompleted (Result Http.Error User) + = SubmittedForm Cred Form + | EnteredEmail String + | EnteredUsername String + | EnteredPassword String + | EnteredBio String + | EnteredAvatar String + | CompletedFormLoad (Result Http.Error Form) + | CompletedSave (Result Http.Error Viewer) + | GotSession Session + | PassedSlowLoadThreshold + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + CompletedFormLoad (Ok form) -> + ( { model | status = Loaded form } + , Cmd.none + ) + CompletedFormLoad (Err _) -> + ( { model | status = Failed } + , Cmd.none + ) -type ExternalMsg - = NoOp - | SetUser User + SubmittedForm cred form -> + case validate form of + Ok validForm -> + ( { model | status = Loaded form } + , edit cred validForm + |> Http.send CompletedSave + ) + Err problems -> + ( { model | problems = problems } + , Cmd.none + ) -update : Session -> Msg -> Model -> ( ( Model, Cmd Msg ), ExternalMsg ) -update session msg model = - case msg of - SubmitForm -> - case validate modelValidator model of - [] -> - session.user - |> Maybe.map .token - |> Request.User.edit model - |> Http.send SaveCompleted - |> pair { model | errors = [] } - => NoOp - - errors -> - { model | errors = errors } - => Cmd.none - => NoOp - - SetEmail email -> - { model | email = email } - => Cmd.none - => NoOp - - SetUsername username -> - { model | username = username } - => Cmd.none - => NoOp - - SetPassword passwordStr -> - let - password = - if String.isEmpty passwordStr then - Nothing - else - Just passwordStr - in - { model | password = password } - => Cmd.none - => NoOp + EnteredEmail email -> + updateForm (\form -> { form | email = email }) model - SetBio bio -> - { model | bio = bio } - => Cmd.none - => NoOp + EnteredUsername username -> + updateForm (\form -> { form | username = username }) model - SetImage imageStr -> - let - image = - if String.isEmpty imageStr then - Nothing - else - Just imageStr - in - { model | image = image } - => Cmd.none - => NoOp + EnteredPassword password -> + updateForm (\form -> { form | password = password }) model - SaveCompleted (Err error) -> + EnteredBio bio -> + updateForm (\form -> { form | bio = bio }) model + + EnteredAvatar avatar -> + updateForm (\form -> { form | avatar = avatar }) model + + CompletedSave (Err error) -> let - errorMessages = - case error of - Http.BadStatus response -> - response.body - |> decodeString (field "errors" errorsDecoder) - |> Result.withDefault [] - - _ -> - [ "unable to save changes" ] - - errors = - errorMessages - |> List.map (\errorMessage -> Form => errorMessage) + serverErrors = + Api.decodeErrors error + |> List.map ServerError in - { model | errors = errors } - => Cmd.none - => NoOp + ( { model | problems = List.append model.problems serverErrors } + , Cmd.none + ) + + CompletedSave (Ok viewer) -> + ( model + , Viewer.store viewer + ) + + GotSession session -> + ( { model | session = session } + , Route.replaceUrl (Session.navKey session) Route.Home + ) + + PassedSlowLoadThreshold -> + case model.status of + Loading -> + ( { model | status = LoadingSlowly } + , Cmd.none + ) + + _ -> + ( model, Cmd.none ) + + +{-| Helper function for `update`. Updates the form and returns Cmd.none. +Useful for recording form fields! +-} +updateForm : (Form -> Form) -> Model -> ( Model, Cmd msg ) +updateForm transform model = + case model.status of + Loaded form -> + ( { model | status = Loaded (transform form) }, Cmd.none ) + + _ -> + ( model, Log.error ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Session.changes GotSession (Session.navKey model.session) + + + +-- EXPORT + + +toSession : Model -> Session +toSession model = + model.session + + + +-- FORM - SaveCompleted (Ok user) -> - model - => Cmd.batch [ storeSession user, Route.modifyUrl Route.Home ] - => SetUser user +{-| 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 --- VALIDATION -- +{-| 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 Field - = Form - | Username +-} +type ValidatedField + = Username | Email | Password - | ImageUrl - | Bio -type alias Error = - ( Field, String ) +fieldsToValidate : List ValidatedField +fieldsToValidate = + [ Username + , Email + , Password + ] -modelValidator : Validator Error Model -modelValidator = - Validate.all - [ ifBlank .username (Username => "username can't be blank.") - , ifBlank .email (Email => "email can't be blank.") - ] +{-| 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 + [] -errorsDecoder : Decoder (List String) -errorsDecoder = - decode (\email username password -> List.concat [ email, username, password ]) - |> optionalError "email" - |> optionalError "username" - |> optionalError "password" +{-| 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 + } -optionalError : String -> Decoder (List String -> a) -> Decoder a -optionalError fieldName = + +-- 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 - errorToString errorMessage = - String.join " " [ fieldName, errorMessage ] + 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 in - optional fieldName (list (Decode.map errorToString string)) [] + Api.settings cred body Viewer.decoder + + +nothingIfEmpty : String -> Maybe String +nothingIfEmpty str = + if String.isEmpty str then + Nothing + + else + Just str diff --git a/src/PaginatedList.elm b/src/PaginatedList.elm new file mode 100644 index 0000000000..55512c53b7 --- /dev/null +++ b/src/PaginatedList.elm @@ -0,0 +1,70 @@ +module PaginatedList exposing (PaginatedList, fromList, map, params, total, values) + +import Html exposing (Html, a, li, text, ul) +import Html.Attributes exposing (class, classList, href) +import Html.Events exposing (onClick) +import Json.Decode as Decode exposing (Decoder) +import Task exposing (Task) +import Url.Builder exposing (QueryParameter) + + + +-- TYPES + + +type PaginatedList a + = PaginatedList + { values : List a + , total : Int + } + + + +-- INFO + + +values : PaginatedList a -> List a +values (PaginatedList info) = + info.values + + +total : PaginatedList a -> Int +total (PaginatedList info) = + info.total + + + +-- CREATE + + +fromList : Int -> List a -> PaginatedList a +fromList totalCount list = + PaginatedList { values = list, total = totalCount } + + + +-- TRANSFORM + + +map : (a -> a) -> PaginatedList a -> PaginatedList a +map transform (PaginatedList info) = + PaginatedList { info | values = List.map transform info.values } + + + +-- PARAMS + + +{-| I decided to accept a record here so I don't mess up the argument order of the two Ints. +-} +params : + { page : Int, resultsPerPage : Int } + -> List QueryParameter +params { page, resultsPerPage } = + let + offset = + (page - 1) * resultsPerPage + in + [ Url.Builder.string "limit" (String.fromInt resultsPerPage) + , Url.Builder.string "offset" (String.fromInt offset) + ] diff --git a/src/Ports.elm b/src/Ports.elm deleted file mode 100644 index 6a842ca3da..0000000000 --- a/src/Ports.elm +++ /dev/null @@ -1,9 +0,0 @@ -port module Ports exposing (onSessionChange, storeSession) - -import Json.Encode exposing (Value) - - -port storeSession : Maybe String -> Cmd msg - - -port onSessionChange : (Value -> msg) -> Sub msg diff --git a/src/Profile.elm b/src/Profile.elm new file mode 100644 index 0000000000..536582a165 --- /dev/null +++ b/src/Profile.elm @@ -0,0 +1,54 @@ +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 exposing (Cred) +import Avatar exposing (Avatar) +import Http +import Json.Decode as Decode exposing (Decoder) +import Json.Decode.Pipeline exposing (required) +import Username exposing (Username) + + + +-- 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 diff --git a/src/Request/Article.elm b/src/Request/Article.elm deleted file mode 100644 index 963c6d8468..0000000000 --- a/src/Request/Article.elm +++ /dev/null @@ -1,272 +0,0 @@ -module Request.Article - exposing - ( FeedConfig - , ListConfig - , create - , defaultFeedConfig - , defaultListConfig - , delete - , feed - , get - , list - , tags - , toggleFavorite - , update - ) - -import Data.Article as Article exposing (Article, Body, Tag, slugToString) -import Data.Article.Feed as Feed exposing (Feed) -import Data.AuthToken exposing (AuthToken, withAuthorization) -import Data.User as User exposing (Username) -import Http -import HttpBuilder exposing (RequestBuilder, withBody, withExpect, withQueryParams) -import Json.Decode as Decode -import Json.Encode as Encode -import Request.Helpers exposing (apiUrl) -import Util exposing ((=>)) - - --- SINGLE -- - - -get : Maybe AuthToken -> Article.Slug -> Http.Request (Article Body) -get maybeToken slug = - let - expect = - Article.decoderWithBody - |> Decode.field "article" - |> Http.expectJson - in - apiUrl ("/articles/" ++ Article.slugToString slug) - |> HttpBuilder.get - |> HttpBuilder.withExpect expect - |> withAuthorization maybeToken - |> HttpBuilder.toRequest - - - --- 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 AuthToken -> Http.Request Feed -list config maybeToken = - [ "tag" => Maybe.map Article.tagToString config.tag - , "author" => Maybe.map User.usernameToString config.author - , "favorited" => Maybe.map User.usernameToString config.favorited - , "limit" => Just (toString config.limit) - , "offset" => Just (toString config.offset) - ] - |> List.filterMap maybeVal - |> buildFromQueryParams "/articles" - |> withAuthorization maybeToken - |> HttpBuilder.toRequest - - - --- FEED -- - - -type alias FeedConfig = - { limit : Int - , offset : Int - } - - -defaultFeedConfig : FeedConfig -defaultFeedConfig = - { limit = 10 - , offset = 0 - } - - -feed : FeedConfig -> AuthToken -> Http.Request Feed -feed config token = - [ "limit" => Just (toString config.limit) - , "offset" => Just (toString config.offset) - ] - |> List.filterMap maybeVal - |> buildFromQueryParams "/articles/feed" - |> withAuthorization (Just token) - |> HttpBuilder.toRequest - - - --- TAGS -- - - -tags : Http.Request (List Tag) -tags = - Decode.field "tags" (Decode.list Article.tagDecoder) - |> Http.get (apiUrl "/tags") - - - --- FAVORITE -- - - -toggleFavorite : Article a -> AuthToken -> Http.Request (Article ()) -toggleFavorite article authToken = - if article.favorited then - unfavorite article.slug authToken - else - favorite article.slug authToken - - -favorite : Article.Slug -> AuthToken -> Http.Request (Article ()) -favorite = - buildFavorite HttpBuilder.post - - -unfavorite : Article.Slug -> AuthToken -> Http.Request (Article ()) -unfavorite = - buildFavorite HttpBuilder.delete - - -buildFavorite : - (String -> RequestBuilder a) - -> Article.Slug - -> AuthToken - -> Http.Request (Article ()) -buildFavorite builderFromUrl slug token = - let - expect = - Article.decoder - |> Decode.field "article" - |> Http.expectJson - in - [ apiUrl "/articles", slugToString slug, "favorite" ] - |> String.join "/" - |> builderFromUrl - |> withAuthorization (Just token) - |> withExpect expect - |> HttpBuilder.toRequest - - - --- CREATE -- - - -type alias CreateConfig record = - { record - | title : String - , description : String - , body : String - , tags : List String - } - - -type alias EditConfig record = - { record - | title : String - , description : String - , body : String - } - - -create : CreateConfig record -> AuthToken -> Http.Request (Article Body) -create config token = - let - expect = - Article.decoderWithBody - |> Decode.field "article" - |> Http.expectJson - - article = - Encode.object - [ "title" => Encode.string config.title - , "description" => Encode.string config.description - , "body" => Encode.string config.body - , "tagList" => Encode.list (List.map Encode.string config.tags) - ] - - body = - Encode.object [ "article" => article ] - |> Http.jsonBody - in - apiUrl "/articles" - |> HttpBuilder.post - |> withAuthorization (Just token) - |> withBody body - |> withExpect expect - |> HttpBuilder.toRequest - - -update : Article.Slug -> EditConfig record -> AuthToken -> Http.Request (Article Body) -update slug config token = - let - expect = - Article.decoderWithBody - |> Decode.field "article" - |> Http.expectJson - - article = - Encode.object - [ "title" => Encode.string config.title - , "description" => Encode.string config.description - , "body" => Encode.string config.body - ] - - body = - Encode.object [ "article" => article ] - |> Http.jsonBody - in - apiUrl ("/articles/" ++ slugToString slug) - |> HttpBuilder.put - |> withAuthorization (Just token) - |> withBody body - |> withExpect expect - |> HttpBuilder.toRequest - - - --- DELETE -- - - -delete : Article.Slug -> AuthToken -> Http.Request () -delete slug token = - apiUrl ("/articles/" ++ Article.slugToString slug) - |> HttpBuilder.delete - |> withAuthorization (Just token) - |> HttpBuilder.toRequest - - - --- HELPERS -- - - -maybeVal : ( a, Maybe b ) -> Maybe ( a, b ) -maybeVal ( key, value ) = - case value of - Nothing -> - Nothing - - Just val -> - Just (key => val) - - -buildFromQueryParams : String -> List ( String, String ) -> RequestBuilder Feed -buildFromQueryParams url queryParams = - url - |> apiUrl - |> HttpBuilder.get - |> withExpect (Http.expectJson Feed.decoder) - |> withQueryParams queryParams diff --git a/src/Request/Article/Comments.elm b/src/Request/Article/Comments.elm deleted file mode 100644 index 7c47ff33c9..0000000000 --- a/src/Request/Article/Comments.elm +++ /dev/null @@ -1,54 +0,0 @@ -module Request.Article.Comments exposing (delete, list, post) - -import Data.Article as Article exposing (Article, Tag, slugToString) -import Data.Article.Comment as Comment exposing (Comment, CommentId) -import Data.AuthToken exposing (AuthToken, withAuthorization) -import Http -import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams) -import Json.Decode as Decode -import Json.Encode as Encode exposing (Value) -import Request.Helpers exposing (apiUrl) -import Util exposing ((=>)) - - --- LIST -- - - -list : Maybe AuthToken -> Article.Slug -> Http.Request (List Comment) -list maybeToken slug = - apiUrl ("/articles/" ++ Article.slugToString slug ++ "/comments") - |> HttpBuilder.get - |> HttpBuilder.withExpect (Http.expectJson (Decode.field "comments" (Decode.list Comment.decoder))) - |> withAuthorization maybeToken - |> HttpBuilder.toRequest - - - --- POST -- - - -post : Article.Slug -> String -> AuthToken -> Http.Request Comment -post slug body token = - apiUrl ("/articles/" ++ Article.slugToString slug ++ "/comments") - |> HttpBuilder.post - |> HttpBuilder.withBody (Http.jsonBody (encodeCommentBody body)) - |> HttpBuilder.withExpect (Http.expectJson (Decode.field "comment" Comment.decoder)) - |> withAuthorization (Just token) - |> HttpBuilder.toRequest - - -encodeCommentBody : String -> Value -encodeCommentBody body = - Encode.object [ "comment" => Encode.object [ "body" => Encode.string body ] ] - - - --- DELETE -- - - -delete : Article.Slug -> CommentId -> AuthToken -> Http.Request () -delete slug commentId token = - apiUrl ("/articles/" ++ Article.slugToString slug ++ "/comments/" ++ Comment.idToString commentId) - |> HttpBuilder.delete - |> withAuthorization (Just token) - |> HttpBuilder.toRequest diff --git a/src/Request/Helpers.elm b/src/Request/Helpers.elm deleted file mode 100644 index b4cee3465a..0000000000 --- a/src/Request/Helpers.elm +++ /dev/null @@ -1,6 +0,0 @@ -module Request.Helpers exposing (apiUrl) - - -apiUrl : String -> String -apiUrl str = - "https://conduit.productionready.io/api" ++ str diff --git a/src/Request/Profile.elm b/src/Request/Profile.elm deleted file mode 100644 index 41352af600..0000000000 --- a/src/Request/Profile.elm +++ /dev/null @@ -1,57 +0,0 @@ -module Request.Profile exposing (get, toggleFollow) - -import Data.AuthToken exposing (AuthToken, withAuthorization) -import Data.Profile as Profile exposing (Profile) -import Data.User as User exposing (Username) -import Http -import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams) -import Json.Decode as Decode -import Request.Helpers exposing (apiUrl) - - --- GET -- - - -get : Username -> Maybe AuthToken -> Http.Request Profile -get username maybeToken = - apiUrl ("/profiles/" ++ User.usernameToString username) - |> HttpBuilder.get - |> HttpBuilder.withExpect (Http.expectJson (Decode.field "profile" Profile.decoder)) - |> withAuthorization maybeToken - |> HttpBuilder.toRequest - - - --- FOLLOWING -- - - -toggleFollow : Username -> Bool -> AuthToken -> Http.Request Profile -toggleFollow username following authToken = - if following then - unfollow username authToken - else - follow username authToken - - -follow : Username -> AuthToken -> Http.Request Profile -follow = - buildFollow HttpBuilder.post - - -unfollow : Username -> AuthToken -> Http.Request Profile -unfollow = - buildFollow HttpBuilder.delete - - -buildFollow : - (String -> RequestBuilder a) - -> Username - -> AuthToken - -> Http.Request Profile -buildFollow builderFromUrl username token = - [ apiUrl "/profiles", User.usernameToString username, "follow" ] - |> String.join "/" - |> builderFromUrl - |> withAuthorization (Just token) - |> withExpect (Http.expectJson (Decode.field "profile" Profile.decoder)) - |> HttpBuilder.toRequest diff --git a/src/Request/User.elm b/src/Request/User.elm deleted file mode 100644 index 30ac465368..0000000000 --- a/src/Request/User.elm +++ /dev/null @@ -1,95 +0,0 @@ -module Request.User exposing (edit, login, register, storeSession) - -import Data.AuthToken exposing (AuthToken, withAuthorization) -import Data.User as User exposing (User) -import Http -import HttpBuilder exposing (RequestBuilder, withExpect, withQueryParams) -import Json.Decode as Decode -import Json.Encode as Encode -import Json.Encode.Extra as EncodeExtra -import Ports -import Request.Helpers exposing (apiUrl) -import Util exposing ((=>)) - - -storeSession : User -> Cmd msg -storeSession user = - User.encode user - |> Encode.encode 0 - |> Just - |> Ports.storeSession - - -login : { r | email : String, password : String } -> Http.Request User -login { email, password } = - let - user = - Encode.object - [ "email" => Encode.string email - , "password" => Encode.string password - ] - - body = - Encode.object [ "user" => user ] - |> Http.jsonBody - in - Decode.field "user" User.decoder - |> Http.post (apiUrl "/users/login") body - - -register : { r | username : String, email : String, password : String } -> Http.Request User -register { username, email, password } = - let - user = - Encode.object - [ "username" => Encode.string username - , "email" => Encode.string email - , "password" => Encode.string password - ] - - body = - Encode.object [ "user" => user ] - |> Http.jsonBody - in - Decode.field "user" User.decoder - |> Http.post (apiUrl "/users") body - - -edit : - { r - | username : String - , email : String - , bio : String - , password : Maybe String - , image : Maybe String - } - -> Maybe AuthToken - -> Http.Request User -edit { username, email, bio, password, image } maybeToken = - let - updates = - [ Just ("username" => Encode.string username) - , Just ("email" => Encode.string email) - , Just ("bio" => Encode.string bio) - , Just ("image" => EncodeExtra.maybe Encode.string image) - , Maybe.map (\pass -> "password" => Encode.string pass) password - ] - |> List.filterMap identity - - body = - ("user" => Encode.object updates) - |> List.singleton - |> Encode.object - |> Http.jsonBody - - expect = - User.decoder - |> Decode.field "user" - |> Http.expectJson - in - apiUrl "/user" - |> HttpBuilder.put - |> HttpBuilder.withExpect expect - |> HttpBuilder.withBody body - |> withAuthorization maybeToken - |> HttpBuilder.toRequest diff --git a/src/Route.elm b/src/Route.elm index dd0b28386b..1e524fe069 100644 --- a/src/Route.elm +++ b/src/Route.elm @@ -1,14 +1,17 @@ -module Route exposing (Route(..), fromLocation, href, modifyUrl) +module Route exposing (Route(..), fromUrl, href, replaceUrl) -import Data.Article as Article -import Data.User as User exposing (Username) +import Article.Slug as Slug exposing (Slug) +import Browser.Navigation as Nav import Html exposing (Attribute) import Html.Attributes as Attr -import Navigation exposing (Location) -import UrlParser as Url exposing ((), Parser, oneOf, parseHash, s, string) +import Profile exposing (Profile) +import Url exposing (Url) +import Url.Parser as Parser exposing ((), Parser, oneOf, s, string) +import Username exposing (Username) --- ROUTING -- + +-- ROUTING type Route @@ -18,29 +21,52 @@ type Route | Logout | Register | Settings - | Article Article.Slug + | Article Slug | Profile Username | NewArticle - | EditArticle Article.Slug + | EditArticle Slug -route : Parser (Route -> a) a -route = +parser : Parser (Route -> a) a +parser = oneOf - [ Url.map Home (s "") - , Url.map Login (s "login") - , Url.map Logout (s "logout") - , Url.map Settings (s "settings") - , Url.map Profile (s "profile" User.usernameParser) - , Url.map Register (s "register") - , Url.map Article (s "article" Article.slugParser) - , Url.map NewArticle (s "editor") - , Url.map EditArticle (s "editor" Article.slugParser) + [ 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) ] --- INTERNAL -- +-- 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 @@ -67,37 +93,15 @@ routeToString page = [ "settings" ] Article slug -> - [ "article", Article.slugToString slug ] + [ "article", Slug.toString slug ] Profile username -> - [ "profile", User.usernameToString username ] + [ "profile", Username.toString username ] NewArticle -> [ "editor" ] EditArticle slug -> - [ "editor", Article.slugToString slug ] + [ "editor", Slug.toString slug ] in "#/" ++ String.join "/" pieces - - - --- PUBLIC HELPERS -- - - -href : Route -> Attribute msg -href route = - Attr.href (routeToString route) - - -modifyUrl : Route -> Cmd msg -modifyUrl = - routeToString >> Navigation.modifyUrl - - -fromLocation : Location -> Maybe Route -fromLocation location = - if String.isEmpty location.hash then - Just Root - else - parseHash route location diff --git a/src/Session.elm b/src/Session.elm new file mode 100644 index 0000000000..8b5436e504 --- /dev/null +++ b/src/Session.elm @@ -0,0 +1,76 @@ +module Session exposing (Session, changes, cred, fromViewer, navKey, viewer) + +import Api exposing (Cred) +import Avatar exposing (Avatar) +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) + + + +-- 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 + + + +-- CHANGES + + +changes : (Session -> msg) -> Nav.Key -> Sub msg +changes toMsg key = + Api.viewerChanges (\maybeViewer -> toMsg (fromViewer key maybeViewer)) Viewer.decoder + + +fromViewer : Nav.Key -> Maybe Viewer -> Session +fromViewer key maybeViewer = + -- It's stored in localStorage as a JSON String; + -- first decode the Value as a String, then + -- decode that String as JSON. + case maybeViewer of + Just viewerVal -> + LoggedIn key viewerVal + + Nothing -> + Guest key diff --git a/src/Timestamp.elm b/src/Timestamp.elm new file mode 100644 index 0000000000..fde03e0e9d --- /dev/null +++ b/src/Timestamp.elm @@ -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: + + +-} +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 diff --git a/src/Username.elm b/src/Username.elm new file mode 100644 index 0000000000..a7f17ec62c --- /dev/null +++ b/src/Username.elm @@ -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 diff --git a/src/Util.elm b/src/Util.elm deleted file mode 100644 index e29d4f439f..0000000000 --- a/src/Util.elm +++ /dev/null @@ -1,50 +0,0 @@ -module Util exposing ((=>), appendErrors, onClickStopPropagation, pair, viewIf) - -import Html exposing (Attribute, Html) -import Html.Events exposing (defaultOptions, onWithOptions) -import Json.Decode as Decode - - -(=>) : a -> b -> ( a, b ) -(=>) = - (,) - - -{-| infixl 0 means the (=>) operator has the same precedence as (<|) and (|>), -meaning you can use it at the end of a pipeline and have the precedence work out. --} -infixl 0 => - - -{-| Useful when building up a Cmd via a pipeline, and then pairing it with -a model at the end. - - session.user - |> User.Request.foo - |> Task.attempt Foo - |> pair { model | something = blah } - --} -pair : a -> b -> ( a, b ) -pair first second = - first => second - - -viewIf : Bool -> Html msg -> Html msg -viewIf condition content = - if condition then - content - else - Html.text "" - - -onClickStopPropagation : msg -> Attribute msg -onClickStopPropagation msg = - onWithOptions "click" - { defaultOptions | stopPropagation = True } - (Decode.succeed msg) - - -appendErrors : { model | errors : List error } -> List error -> { model | errors : List error } -appendErrors model errors = - { model | errors = model.errors ++ errors } diff --git a/src/Viewer.elm b/src/Viewer.elm new file mode 100644 index 0000000000..58ec00552e --- /dev/null +++ b/src/Viewer.elm @@ -0,0 +1,66 @@ +module Viewer exposing (Viewer, avatar, cred, decoder, minPasswordChars, store, username) + +{-| The logged-in user currently viewing this page. It stores enough data to +be able to render the menu bar (username and avatar), along with Cred so it's +impossible to have a Viewer if you aren't logged in. +-} + +import Api exposing (Cred) +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) + + + +-- TYPES + + +type Viewer + = Viewer Avatar Cred + + + +-- INFO + + +cred : Viewer -> Cred +cred (Viewer _ val) = + val + + +username : Viewer -> Username +username (Viewer _ val) = + Api.username val + + +avatar : Viewer -> Avatar +avatar (Viewer val _) = + val + + +{-| Passwords must be at least this many characters long! +-} +minPasswordChars : Int +minPasswordChars = + 6 + + + +-- SERIALIZATION + + +decoder : Decoder (Cred -> Viewer) +decoder = + Decode.succeed Viewer + |> custom (Decode.field "image" Avatar.decoder) + + +store : Viewer -> Cmd msg +store (Viewer avatarVal credVal) = + Api.storeCredWith + credVal + avatarVal diff --git a/src/Views/Article.elm b/src/Views/Article.elm deleted file mode 100644 index c1cc4a0446..0000000000 --- a/src/Views/Article.elm +++ /dev/null @@ -1,60 +0,0 @@ -module Views.Article exposing (view, viewTimestamp) - -{-| Viewing a preview of an individual article, excluding its body. --} - -import Data.Article exposing (Article) -import Data.UserPhoto as UserPhoto exposing (UserPhoto) -import Date.Format -import Html exposing (..) -import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src) -import Route exposing (Route) -import Views.Article.Favorite as Favorite -import Views.Author - - --- VIEWS -- - - -{-| Some pages want to view just the timestamp, not the whole article. --} -viewTimestamp : Article a -> Html msg -viewTimestamp article = - span [ class "date" ] [ text (formattedTimestamp article) ] - - -view : (Article a -> msg) -> Article a -> Html msg -view toggleFavorite article = - let - author = - article.author - in - div [ class "article-preview" ] - [ div [ class "article-meta" ] - [ a [ Route.href (Route.Profile author.username) ] - [ img [ UserPhoto.src author.image ] [] ] - , div [ class "info" ] - [ Views.Author.view author.username - , viewTimestamp article - ] - , Favorite.button - toggleFavorite - article - [ class "pull-xs-right" ] - [ text (" " ++ toString article.favoritesCount) ] - ] - , a [ class "preview-link", Route.href (Route.Article article.slug) ] - [ h1 [] [ text article.title ] - , p [] [ text article.description ] - , span [] [ text "Read more..." ] - ] - ] - - - --- INTERNAL -- - - -formattedTimestamp : Article a -> String -formattedTimestamp article = - Date.Format.format "%B %e, %Y" article.createdAt diff --git a/src/Views/Article/Favorite.elm b/src/Views/Article/Favorite.elm deleted file mode 100644 index 644ac9ef18..0000000000 --- a/src/Views/Article/Favorite.elm +++ /dev/null @@ -1,42 +0,0 @@ -module Views.Article.Favorite exposing (button) - -{-| The Favorite button. --} - -import Data.Article exposing (Article) -import Html exposing (Attribute, Html, i, text) -import Html.Attributes exposing (class) -import Util exposing ((=>), onClickStopPropagation) - - -{-| 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. - --} -button : - (Article a -> msg) - -> Article a - -> List (Attribute msg) - -> List (Html msg) - -> Html msg -button toggleFavorite article extraAttributes extraChildren = - let - favoriteButtonClass = - if article.favorited then - "btn-primary" - else - "btn-outline-primary" - - attributes = - [ class ("btn btn-sm " ++ favoriteButtonClass) - , onClickStopPropagation (toggleFavorite article) - ] - ++ extraAttributes - - children = - [ i [ class "ion-heart" ] [] ] - ++ extraChildren - in - Html.button attributes children diff --git a/src/Views/Article/Feed.elm b/src/Views/Article/Feed.elm deleted file mode 100644 index e844bb44d2..0000000000 --- a/src/Views/Article/Feed.elm +++ /dev/null @@ -1,415 +0,0 @@ -module Views.Article.Feed exposing (FeedSource, Model, Msg, authorFeed, favoritedFeed, globalFeed, init, selectTag, tagFeed, update, viewArticles, viewFeedSources, yourFeed) - -{-| NOTE: This module has its own Model, view, and update. This is not normal! -If you find yourself doing this often, please watch - -This is the reusable Article Feed that appears on both the Home page as well as -on the Profile page. There's a lot of logic here, so it's more convenient to use -the heavyweight approach of giving this its own Model, view, and update. - -This means callers must use Html.map and Cmd.map to use this thing, but in -this case that's totally worth it because of the amount of logic wrapped up -in this thing. - -For every other reusable view in this application, this API would be totally -overkill, so we use simpler APIs instead. - --} - -import Data.Article as Article exposing (Article, Tag) -import Data.Article.Feed exposing (Feed) -import Data.AuthToken exposing (AuthToken) -import Data.Session exposing (Session) -import Data.User exposing (Username) -import Dom.Scroll -import Html exposing (..) -import Html.Attributes exposing (attribute, class, classList, href, id, placeholder, src) -import Html.Events exposing (onClick) -import Http -import Request.Article -import SelectList exposing (Position(..), SelectList) -import Task exposing (Task) -import Util exposing ((=>), onClickStopPropagation, pair, viewIf) -import Views.Article -import Views.Errors as Errors -import Views.Page exposing (bodyId) -import Views.Spinner exposing (spinner) - - --- 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 file. --} -type alias InternalModel = - { errors : List String - , feed : Feed - , feedSources : SelectList FeedSource - , activePage : Int - , isLoading : Bool - } - - -init : Session -> SelectList FeedSource -> Task Http.Error Model -init session feedSources = - let - source = - SelectList.selected feedSources - - toModel ( activePage, feed ) = - Model - { errors = [] - , activePage = activePage - , feed = feed - , feedSources = feedSources - , isLoading = False - } - in - source - |> fetch (Maybe.map .token session.user) 1 - |> Task.map toModel - - - --- VIEW -- - - -viewArticles : Model -> List (Html Msg) -viewArticles (Model { activePage, feed, feedSources }) = - List.map (Views.Article.view ToggleFavorite) feed.articles - ++ [ pagination activePage feed (SelectList.selected feedSources) ] - - -viewFeedSources : Model -> Html Msg -viewFeedSources (Model { feedSources, isLoading, errors }) = - ul [ class "nav nav-pills outline-active" ] <| - SelectList.toList (SelectList.mapBy viewFeedSource feedSources) - ++ [ Errors.view DismissErrors errors, viewIf isLoading spinner ] - - -viewFeedSource : Position -> FeedSource -> Html Msg -viewFeedSource position source = - li [ class "nav-item" ] - [ a - [ classList [ "nav-link" => True, "active" => position == Selected ] - , href "javascript:void(0);" - , onClick (SelectFeedSource source) - ] - [ text (sourceName source) ] - ] - - -selectTag : Maybe AuthToken -> Tag -> Cmd Msg -selectTag maybeAuthToken tagName = - let - source = - tagFeed tagName - in - source - |> fetch maybeAuthToken 1 - |> Task.attempt (FeedLoadCompleted source) - - -sourceName : FeedSource -> String -sourceName source = - case source of - YourFeed -> - "Your Feed" - - GlobalFeed -> - "Global Feed" - - TagFeed tagName -> - "#" ++ Article.tagToString tagName - - FavoritedFeed username -> - "Favorited Articles" - - AuthorFeed username -> - "My Articles" - - -limit : FeedSource -> Int -limit feedSource = - case feedSource of - YourFeed -> - 10 - - GlobalFeed -> - 10 - - TagFeed tagName -> - 10 - - FavoritedFeed username -> - 5 - - AuthorFeed username -> - 5 - - -pagination : Int -> Feed -> FeedSource -> Html Msg -pagination activePage feed feedSource = - let - articlesPerPage = - limit feedSource - - totalPages = - ceiling (toFloat feed.articlesCount / toFloat articlesPerPage) - in - if totalPages > 1 then - List.range 1 totalPages - |> List.map (\page -> pageLink page (page == activePage)) - |> ul [ class "pagination" ] - else - Html.text "" - - -pageLink : Int -> Bool -> Html Msg -pageLink page isActive = - li [ classList [ "page-item" => True, "active" => isActive ] ] - [ a - [ class "page-link" - , href "javascript:void(0);" - , onClick (SelectPage page) - ] - [ text (toString page) ] - ] - - - --- UPDATE -- - - -type Msg - = DismissErrors - | SelectFeedSource FeedSource - | FeedLoadCompleted FeedSource (Result Http.Error ( Int, Feed )) - | ToggleFavorite (Article ()) - | FavoriteCompleted (Result Http.Error (Article ())) - | SelectPage Int - - -update : Session -> Msg -> Model -> ( Model, Cmd Msg ) -update session msg (Model internalModel) = - updateInternal session msg internalModel - |> Tuple.mapFirst Model - - -updateInternal : Session -> Msg -> InternalModel -> ( InternalModel, Cmd Msg ) -updateInternal session msg model = - case msg of - DismissErrors -> - { model | errors = [] } => Cmd.none - - SelectFeedSource source -> - source - |> fetch (Maybe.map .token session.user) 1 - |> Task.attempt (FeedLoadCompleted source) - |> pair { model | isLoading = True } - - FeedLoadCompleted source (Ok ( activePage, feed )) -> - { model - | feed = feed - , feedSources = selectFeedSource source model.feedSources - , activePage = activePage - , isLoading = False - } - => Cmd.none - - FeedLoadCompleted _ (Err error) -> - { model - | errors = model.errors ++ [ "Server error while trying to load feed" ] - , isLoading = False - } - => Cmd.none - - ToggleFavorite article -> - case session.user of - Nothing -> - { model | errors = model.errors ++ [ "You are currently signed out. You must sign in to favorite articles." ] } - => Cmd.none - - Just user -> - Request.Article.toggleFavorite article user.token - |> Http.send FavoriteCompleted - |> pair model - - FavoriteCompleted (Ok article) -> - let - feed = - model.feed - - newFeed = - { feed | articles = List.map (replaceArticle article) feed.articles } - in - { model | feed = newFeed } => Cmd.none - - FavoriteCompleted (Err error) -> - { model | errors = model.errors ++ [ "Server error while trying to favorite article." ] } - => Cmd.none - - SelectPage page -> - let - source = - SelectList.selected model.feedSources - in - source - |> fetch (Maybe.map .token session.user) page - |> Task.andThen (\feed -> Task.map (\_ -> feed) scrollToTop) - |> Task.attempt (FeedLoadCompleted source) - |> pair model - - -scrollToTop : Task x () -scrollToTop = - Dom.Scroll.toTop bodyId - -- 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 AuthToken -> Int -> FeedSource -> Task Http.Error ( Int, Feed ) -fetch token page feedSource = - let - defaultListConfig = - Request.Article.defaultListConfig - - articlesPerPage = - limit feedSource - - offset = - (page - 1) * articlesPerPage - - listConfig = - { defaultListConfig | offset = offset, limit = articlesPerPage } - - task = - case feedSource of - YourFeed -> - let - defaultFeedConfig = - Request.Article.defaultFeedConfig - - feedConfig = - { defaultFeedConfig | offset = offset, limit = articlesPerPage } - in - token - |> Maybe.map (Request.Article.feed feedConfig >> Http.toTask) - |> Maybe.withDefault (Task.fail (Http.BadUrl "You need to be signed in to view your feed.")) - - GlobalFeed -> - Request.Article.list listConfig token - |> Http.toTask - - TagFeed tagName -> - Request.Article.list { listConfig | tag = Just tagName } token - |> Http.toTask - - FavoritedFeed username -> - Request.Article.list { listConfig | favorited = Just username } token - |> Http.toTask - - AuthorFeed username -> - Request.Article.list { listConfig | author = Just username } token - |> Http.toTask - in - task - |> Task.map (\feed -> ( page, feed )) - - -replaceArticle : Article a -> Article a -> Article a -replaceArticle newArticle oldArticle = - if newArticle.slug == oldArticle.slug then - newArticle - else - oldArticle - - -selectFeedSource : FeedSource -> SelectList FeedSource -> SelectList FeedSource -selectFeedSource source sources = - let - withoutTags = - sources - |> SelectList.toList - |> List.filter (not << isTagFeed) - - newSources = - case source of - YourFeed -> - withoutTags - - GlobalFeed -> - withoutTags - - FavoritedFeed _ -> - withoutTags - - AuthorFeed _ -> - withoutTags - - TagFeed _ -> - withoutTags ++ [ source ] - in - case newSources of - [] -> - -- This should never happen. If we had a logging service set up, - -- we would definitely want to report if it somehow did happen! - sources - - first :: rest -> - SelectList.fromLists [] first rest - |> SelectList.select ((==) source) - - -isTagFeed : FeedSource -> Bool -isTagFeed source = - case source of - TagFeed _ -> - True - - _ -> - False - - - --- FEEDSOURCE -- - - -type FeedSource - = YourFeed - | GlobalFeed - | TagFeed Tag - | FavoritedFeed Username - | AuthorFeed Username - - -yourFeed : FeedSource -yourFeed = - YourFeed - - -globalFeed : FeedSource -globalFeed = - GlobalFeed - - -tagFeed : Tag -> FeedSource -tagFeed = - TagFeed - - -favoritedFeed : Username -> FeedSource -favoritedFeed = - FavoritedFeed - - -authorFeed : Username -> FeedSource -authorFeed = - AuthorFeed diff --git a/src/Views/Author.elm b/src/Views/Author.elm deleted file mode 100644 index 6954295bb8..0000000000 --- a/src/Views/Author.elm +++ /dev/null @@ -1,16 +0,0 @@ -module Views.Author exposing (view) - -{-| View an author. We basically render their username and a link to their -profile, and that's it. --} - -import Data.User as User exposing (Username) -import Html exposing (Html, a) -import Html.Attributes exposing (attribute, class, href, id, placeholder) -import Route exposing (Route) - - -view : Username -> Html msg -view username = - a [ class "author", Route.href (Route.Profile username) ] - [ User.usernameToHtml username ] diff --git a/src/Views/Errors.elm b/src/Views/Errors.elm deleted file mode 100644 index 02cda7595c..0000000000 --- a/src/Views/Errors.elm +++ /dev/null @@ -1,30 +0,0 @@ -module Views.Errors exposing (view) - -{-| Render dismissable errors. We use this all over the place! --} - -import Html exposing (..) -import Html.Attributes exposing (class, style) -import Html.Events exposing (onClick) -import Util exposing ((=>)) - - -view : msg -> List String -> Html msg -view dismissErrors errors = - if List.isEmpty errors then - Html.text "" - else - div [ class "error-messages", styles ] <| - List.map (\error -> p [] [ text error ]) errors - ++ [ button [ onClick dismissErrors ] [ text "Ok" ] ] - - -styles : Attribute msg -styles = - style - [ "position" => "fixed" - , "top" => "0" - , "background" => "rgb(250, 250, 250)" - , "padding" => "20px" - , "border" => "1px solid" - ] diff --git a/src/Views/Form.elm b/src/Views/Form.elm deleted file mode 100644 index e38694ebd6..0000000000 --- a/src/Views/Form.elm +++ /dev/null @@ -1,40 +0,0 @@ -module Views.Form exposing (input, password, textarea, viewErrors) - -import Html exposing (Attribute, Html, fieldset, li, text, ul) -import Html.Attributes exposing (class, type_) - - -password : List (Attribute msg) -> List (Html msg) -> Html msg -password attrs = - control Html.input ([ type_ "password" ] ++ attrs) - - -input : List (Attribute msg) -> List (Html msg) -> Html msg -input attrs = - control Html.input ([ type_ "text" ] ++ attrs) - - -textarea : List (Attribute msg) -> List (Html msg) -> Html msg -textarea = - control Html.textarea - - -viewErrors : List ( a, String ) -> Html msg -viewErrors errors = - errors - |> List.map (\( _, error ) -> li [] [ text error ]) - |> ul [ class "error-messages" ] - - - --- INTERNAL -- - - -control : - (List (Attribute msg) -> List (Html msg) -> Html msg) - -> List (Attribute msg) - -> List (Html msg) - -> Html msg -control element attributes children = - fieldset [ class "form-group" ] - [ element (class "form-control" :: attributes) children ] diff --git a/src/Views/Spinner.elm b/src/Views/Spinner.elm deleted file mode 100644 index e8aa03a22f..0000000000 --- a/src/Views/Spinner.elm +++ /dev/null @@ -1,14 +0,0 @@ -module Views.Spinner exposing (spinner) - -import Html exposing (Attribute, Html, div, li) -import Html.Attributes exposing (class, style) -import Util exposing ((=>)) - - -spinner : Html msg -spinner = - li [ class "sk-three-bounce", style [ "float" => "left", "margin" => "8px" ] ] - [ div [ class "sk-child sk-bounce1" ] [] - , div [ class "sk-child sk-bounce2" ] [] - , div [ class "sk-child sk-bounce3" ] [] - ] diff --git a/src/Views/User/Follow.elm b/src/Views/User/Follow.elm deleted file mode 100644 index 645568a3a9..0000000000 --- a/src/Views/User/Follow.elm +++ /dev/null @@ -1,41 +0,0 @@ -module Views.User.Follow exposing (State, button) - -{-| The Follow button. - -This API accepts a "toggle follow" message and the current state of whether -the user is already being followed. It's very lightweight! - -It would be overkill to give something this simple its own Model, Msg, and -update. That would make it way more work to use than it needed to be, -and for no benefit. - --} - -import Data.User as User exposing (Username) -import Html exposing (Html, i, text) -import Html.Attributes exposing (class) -import Html.Events exposing (onClick) - - -type alias State record = - { record | following : Bool, username : Username } - - -button : (Username -> msg) -> State record -> Html msg -button toggleFollow { following, username } = - let - ( prefix, secondaryClass ) = - if following then - ( "Unfollow", "btn-secondary" ) - else - ( "Follow", "btn-outline-secondary" ) - - classes = - [ "btn", "btn-sm", secondaryClass, "action-btn" ] - |> String.join " " - |> class - in - Html.button [ classes, onClick (toggleFollow username) ] - [ i [ class "ion-plus-round" ] [] - , text (" " ++ prefix ++ " " ++ User.usernameToString username) - ] diff --git a/tests/RoutingTests.elm b/tests/RoutingTests.elm index 2efa210999..b096a19993 100644 --- a/tests/RoutingTests.elm +++ b/tests/RoutingTests.elm @@ -1,77 +1,73 @@ module RoutingTests exposing (..) -import Data.Article as Article exposing (Slug) -import Data.User as User exposing (Username) +import Article +import Article.Slug as Slug exposing (Slug) import Expect exposing (Expectation) -import Json.Decode exposing (decodeString) -import Navigation exposing (Location) +import Json.Decode as Decode exposing (decodeString) import Route exposing (Route(..)) import Test exposing (..) +import Url exposing (Url) +import Username exposing (Username) -- TODO need to add lots more tests! -fromLocation : Test -fromLocation = - describe "Route.fromLocation" - [ testLocation "" Root - , testLocation "#login" Login - , testLocation "#logout" Logout - , testLocation "#settings" Settings - , testLocation "#profile/foo" (Profile (usernameFromStr "foo")) - , testLocation "#register" Register - , testLocation "#article/foo" (Article (slugFromStr "foo")) - , testLocation "#editor" NewArticle - , testLocation "#editor/foo" (EditArticle (slugFromStr "foo")) +fromUrl : Test +fromUrl = + describe "Route.fromUrl" + [ testUrl "" Root + , testUrl "#login" Login + , testUrl "#logout" Logout + , testUrl "#settings" Settings + , testUrl "#profile/foo" (Profile (usernameFromStr "foo")) + , testUrl "#register" Register + , testUrl "#article/foo" (Article (slugFromStr "foo")) + , testUrl "#editor" NewArticle + , testUrl "#editor/foo" (EditArticle (slugFromStr "foo")) ] --- HELPERS -- +-- HELPERS -testLocation : String -> Route -> Test -testLocation hash route = +testUrl : String -> Route -> Test +testUrl hash route = test ("Parsing hash: \"" ++ hash ++ "\"") <| \() -> - makeHashLocation hash - |> Route.fromLocation + fragment hash + |> Route.fromUrl |> Expect.equal (Just route) -makeHashLocation : String -> Location -makeHashLocation hash = - { hash = hash - , href = "" - , host = "" - , hostname = "" - , protocol = "" - , origin = "" - , port_ = "" - , pathname = "" - , search = "" - , username = "" - , password = "" +fragment : String -> Url +fragment frag = + { protocol = Url.Http + , host = "foo.com" + , port_ = Nothing + , path = "bar" + , query = Nothing + , fragment = Just frag } --- CONSTRUCTING UNEXPOSED VALUES -- --- By decoding values that are not intended to be exposed directly - and crashing --- if they cannot be decoded, since crashing is harmless in tests - we can let +-- CONSTRUCTING UNEXPOSED VALUES +-- By decoding values that are not intended to be exposed directly - and erroring +-- if they cannot be decoded, since this is harmless in tests - we can let -- our internal modules continue to expose only the intended ways of -- constructing those, while still being able to test them. usernameFromStr : String -> Username usernameFromStr str = - case decodeString User.usernameDecoder ("\"" ++ str ++ "\"") of + case decodeString Username.decoder ("\"" ++ str ++ "\"") of Ok username -> username Err err -> - Debug.crash ("Error decoding Username from \"" ++ str ++ "\": " ++ err) + Debug.todo ("Error decoding Username from \"" ++ str ++ "\": " ++ Decode.errorToString err) slugFromStr : String -> Slug @@ -96,9 +92,9 @@ slugFromStr str = } """ in - case decodeString Article.decoder json of + case decodeString (Article.previewDecoder Nothing) json of Ok article -> - article.slug + Article.slug article Err err -> - Debug.crash ("Error decoding Slug from \"" ++ str ++ "\": " ++ err) + Debug.todo ("Error decoding Slug from \"" ++ str ++ "\": " ++ Decode.errorToString err)