From e5f60fb7a6336d657b897cee9175a870bf09a809 Mon Sep 17 00:00:00 2001 From: Tim DuBois Date: Wed, 22 Aug 2018 18:17:44 +0200 Subject: [PATCH] elm-upgrade first pass --- app/elm/Data/Comment.elm | 12 +- app/elm/Data/User.elm | 1 + app/elm/Main.elm | 2 +- app/elm/Markdown.elm | 15 +- app/elm/Msg.elm | 2 +- app/elm/Style.elm | 2 +- app/elm/Stylesheets.elm | 3 +- app/elm/Time/DateTime/Distance.elm | 13 +- app/elm/Update.elm | 255 ++++++++++++++++++----------- app/elm/Util.elm | 5 +- app/elm/View.elm | 23 ++- app/elm/elm-package.json | 29 ---- app/elm/elm.json | 36 ++++ app/elm/tests/Helpers/Dates.elm | 3 +- app/elm/tests/Tests.elm | 4 +- 15 files changed, 257 insertions(+), 148 deletions(-) delete mode 100644 app/elm/elm-package.json create mode 100644 app/elm/elm.json diff --git a/app/elm/Data/Comment.elm b/app/elm/Data/Comment.elm index 3c4e877b..c72cec05 100644 --- a/app/elm/Data/Comment.elm +++ b/app/elm/Data/Comment.elm @@ -1,4 +1,4 @@ -module Data.Comment exposing (Comment, Edited, Inserted, Responses(Responses), count, decoder, delete, disableVote, dislike, editDecoder, encode, getText, insertDecoder, insertNew, like, readOnly, toggleVisible, update) +module Data.Comment exposing (Comment, Edited, Inserted, Responses(..), count, decoder, delete, disableVote, dislike, editDecoder, encode, getText, insertDecoder, insertNew, like, readOnly, toggleVisible, update) import Json.Decode as Decode exposing (Decoder) import Json.Decode.Extra as DecodeExtra @@ -77,6 +77,7 @@ insertNew insert current = in if isNothing insert.parent then comments ++ List.singleton newComment + else List.map (\comment -> injectNew insert newComment comment) comments @@ -89,6 +90,7 @@ injectNew insert newComment comment = case comment.children of Responses responses -> Responses <| responses ++ List.singleton newComment + else case comment.children of Responses responses -> @@ -111,6 +113,7 @@ injectUpdates edit comment = , hash = edit.hash , editable = True } + else mapChildren edit comment injectUpdates @@ -124,6 +127,7 @@ switchVisible : Int -> Comment -> Comment switchVisible id comment = if comment.id == id then { comment | visible = not comment.visible } + else mapChildren id comment switchVisible @@ -146,6 +150,7 @@ filterComment id comment = in if noChildren then Nothing + else --We must display a masked delete let @@ -163,6 +168,7 @@ filterComment id comment = , votes = 0 , votable = False } + else let children = @@ -182,6 +188,7 @@ removeEditable : Int -> Comment -> Comment removeEditable id comment = if comment.id == id then { comment | editable = False } + else mapChildren id comment removeEditable @@ -212,6 +219,7 @@ voteComment ( id, like ) comment = | votes = count , votable = False } + else mapChildren ( id, like ) comment voteComment @@ -225,6 +233,7 @@ removeVotable : Int -> Comment -> Comment removeVotable id comment = if comment.id == id then { comment | votable = False } + else mapChildren id comment removeVotable @@ -266,6 +275,7 @@ findText : Int -> Comment -> String findText id comment = if comment.id == id then comment.text + else "" diff --git a/app/elm/Data/User.elm b/app/elm/Data/User.elm index 18ea3ecd..c21ef38a 100644 --- a/app/elm/Data/User.elm +++ b/app/elm/Data/User.elm @@ -39,6 +39,7 @@ getIdentity user = in if List.all isNothing data then user.iphash ? "" + else -- Join with b since it gives the authors' credentials a cool identicon Crypto.Hash.sha224 (String.join "b" unwrapped) diff --git a/app/elm/Main.elm b/app/elm/Main.elm index a441d77e..0c6742b5 100644 --- a/app/elm/Main.elm +++ b/app/elm/Main.elm @@ -1,7 +1,7 @@ module Main exposing (main) import Http -import Models exposing (Model, Status(Commenting)) +import Models exposing (Model, Status(..)) import Msg exposing (Msg) import Navigation import Request.Comment diff --git a/app/elm/Markdown.elm b/app/elm/Markdown.elm index fc3a4469..4bf5d733 100644 --- a/app/elm/Markdown.elm +++ b/app/elm/Markdown.elm @@ -1,10 +1,7 @@ -module Markdown - exposing - ( Options - , defaultOptions - , toHtml - , toHtmlWith - ) +module Markdown exposing + ( toHtml + , Options, defaultOptions, toHtmlWith + ) {-| A library for markdown parsing. This is just an Elm API built on top of the [markdown-it](https://github.com/markdown-it/markdown-it) project which focuses on speed. @@ -77,11 +74,13 @@ toHtml attrs string = -- Russian { doubleLeft = "«", doubleRight = "»", singleLeft = "„", singleRight = "“" } + -- German { doubleLeft = "„", doubleRight = "“", singleLeft = "‚", singleRight = "‘" } + -- French - { doubleLeft = "«\xA0", doubleRight = "\xA0»", singleLeft = "‹\xA0", singleRight = "\xA0›" } + { doubleLeft = "«\u{00A0}", doubleRight = "\u{00A0}»", singleLeft = "‹\u{00A0}", singleRight = "\u{00A0}›" } [gfm]: https://help.github.com/articles/github-flavored-markdown/ [fenced]: https://help.github.com/articles/github-flavored-markdown/#fenced-code-blocks diff --git a/app/elm/Msg.elm b/app/elm/Msg.elm index 89d1dee2..3ce0e451 100644 --- a/app/elm/Msg.elm +++ b/app/elm/Msg.elm @@ -1,4 +1,4 @@ -module Msg exposing (..) +module Msg exposing (Msg(..)) import Data.Comment exposing (Comment, Edited, Inserted) import Data.Init exposing (Init) diff --git a/app/elm/Style.elm b/app/elm/Style.elm index f8948d36..d11c3728 100644 --- a/app/elm/Style.elm +++ b/app/elm/Style.elm @@ -1,4 +1,4 @@ -module Style exposing (..) +module Style exposing (OrationClasses(..), OrationIds(..), activeColor, clickableStyle, css, hoverColor, inputStyle, orationNamespace, primaryColor) import Css exposing (..) import Css.Elements exposing (button, img, input, label, li, p, textarea, typeSelector) diff --git a/app/elm/Stylesheets.elm b/app/elm/Stylesheets.elm index 8c2bf656..a68b90f7 100644 --- a/app/elm/Stylesheets.elm +++ b/app/elm/Stylesheets.elm @@ -1,10 +1,11 @@ -port module Stylesheets exposing (..) +port module Stylesheets exposing (fileStructure, files, main) import Css.File exposing (CssCompilerProgram, CssFileStructure) import Css.Normalize import Style + {- Stylesheets -} diff --git a/app/elm/Time/DateTime/Distance.elm b/app/elm/Time/DateTime/Distance.elm index 0aded6ff..b9236f4b 100644 --- a/app/elm/Time/DateTime/Distance.elm +++ b/app/elm/Time/DateTime/Distance.elm @@ -105,41 +105,52 @@ calculateDistance delta = in if minutes == 0 then LessThanXMinutes 1 + else if minutes < 2 then XMinutes minutes + else if minutes < 45 then -- 2 mins up to 0.75 hrs XMinutes minutes + else if minutes < 90 then -- 0.75 hrs up to 1.5 hrs AboutXHours 1 + else if minutes < minutes_in_day then -- 1.5 hrs up to 24 hrs upToOneDay minutes + else if minutes < minutes_in_almost_two_days then -- 1 day up to 1.75 days XDays 1 + else if minutes < minutes_in_month then -- 1.75 days up to 30 days upToOneMonth minutes + else if minutes < minutes_in_two_months then -- 1 month up to 2 months upToTwoMonths minutes + else if months < 12 then -- 2 months up to 12 months upToOneYear minutes + else -- 1 year up to max Date let monthsSinceStartOfYear = - months % 12 + modBy 12 months in if monthsSinceStartOfYear < 3 then -- N years up to 1 years 3 months AboutXYears years + else if monthsSinceStartOfYear < 9 then -- N years 3 months up to N years 9 months OverXYears years + else -- N years 9 months up to N year 12 months AlmostXYears <| years + 1 diff --git a/app/elm/Update.elm b/app/elm/Update.elm index b224e9c4..191b9b05 100644 --- a/app/elm/Update.elm +++ b/app/elm/Update.elm @@ -18,35 +18,45 @@ update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of UpdateComment comment -> - { model | comment = comment } ! [] + ( { model | comment = comment } + , Cmd.none + ) UpdateName name -> let user = model.user in - { model | user = { user | name = name } } ! [] + ( { model | user = { user | name = name } } + , Cmd.none + ) UpdateEmail email -> let user = model.user in - { model | user = { user | email = email } } ! [] + ( { model | user = { user | email = email } } + , Cmd.none + ) UpdateUrl url -> let user = model.user in - { model | user = { user | url = url } } ! [] + ( { model | user = { user | url = url } } + , Cmd.none + ) UpdatePreview -> let user = model.user in - { model | user = { user | preview = not model.user.preview } } ! [] + ( { model | user = { user | preview = not model.user.preview } } + , Cmd.none + ) SetPreview strPreview -> let @@ -56,17 +66,19 @@ update msg model = preview_ = dumbDecode strPreview in - { model | user = { user | preview = preview_ } } ! [] + ( { model | user = { user | preview = preview_ } } + , Cmd.none + ) StoreUser -> - model - ! [ Cmd.batch - [ Ports.setName model.user.name - , Ports.setEmail model.user.email - , Ports.setUrl model.user.url - , Ports.setPreview (Just <| toString model.user.preview) - ] - ] + ( model + , Cmd.batch + [ Ports.setName model.user.name + , Ports.setEmail model.user.email + , Ports.setUrl model.user.url + , Ports.setPreview (Just <| toString model.user.preview) + ] + ) Count (Ok strCount) -> let @@ -78,26 +90,34 @@ update msg model = Err _ -> 0 in - { model | count = intCount } ! [] + ( { model | count = intCount } + , Cmd.none + ) Count (Err error) -> - { model | debug = toString error } ! [] + ( { model | debug = toString error } + , Cmd.none + ) Post location -> - { model | post = location } ! [] + ( { model | post = location } + , Cmd.none + ) Title value -> - { model | title = value } ! [] + ( { model | title = value } + , Cmd.none + ) PostComment -> - model - ! [ let - postReq = - Request.Comment.post model - |> Http.toTask - in - Task.attempt PostConfirm postReq - ] + ( model + , let + postReq = + Request.Comment.post model + |> Http.toTask + in + Task.attempt PostConfirm postReq + ) PostConfirm (Ok result) -> let @@ -110,7 +130,7 @@ update msg model = comments = Comment.insertNew result ( model.comment, author, model.now, model.comments ) in - { model + ( { model | comment = "" , parent = Nothing , count = model.count + 1 @@ -118,18 +138,21 @@ update msg model = , comments = comments , status = Commenting , user = { user | identity = author } - } - ! [ timeoutEdits model.editTimeout result.id ] + } + , timeoutEdits model.editTimeout result.id + ) PostConfirm (Err error) -> - { model | debug = toString error } ! [] + ( { model | debug = toString error } + , Cmd.none + ) Hashes (Ok result) -> let user = model.user in - { model + ( { model | user = { user | iphash = result.userIp @@ -137,88 +160,105 @@ update msg model = } , blogAuthor = result.blogAuthor ? "" , editTimeout = result.editTimeout - } - ! [] + } + , Cmd.none + ) Hashes (Err error) -> - { model | debug = toString error } ! [] + ( { model | debug = toString error } + , Cmd.none + ) Comments (Ok result) -> let count = Comment.count result in - { model + ( { model | comments = result , count = count - } - ! [] + } + , Cmd.none + ) Comments (Err error) -> - { model | debug = toString error } ! [] + ( { model | debug = toString error } + , Cmd.none + ) GetDate _ -> - model ! [ Task.perform NewDate currentDate ] + ( model + , Task.perform NewDate currentDate + ) NewDate date -> - { model | now = date } ! [] + ( { model | now = date } + , Cmd.none + ) CommentReply id -> let value = if model.parent == Just id then Nothing + else Just id status = if model.parent == Just id then Commenting + else Replying in - { model + ( { model | parent = value , status = status - } - ! [] + } + , Cmd.none + ) CommentEdit id -> let value = if model.parent == Just id then Nothing + else Just id status = if model.parent == Just id then Commenting + else Editing comment = if model.parent == Just id then "" + else Comment.getText id model.comments in - { model + ( { model | parent = value , comment = comment , status = status - } - ! [ timeoutEdits model.editTimeout id ] + } + , timeoutEdits model.editTimeout id + ) SendEdit id -> - model - ! [ let - postReq = - Request.Comment.edit id model - |> Http.toTask - in - Task.attempt EditConfirm postReq - ] + ( model + , let + postReq = + Request.Comment.edit id model + |> Http.toTask + in + Task.attempt EditConfirm postReq + ) EditConfirm (Ok result) -> let @@ -228,63 +268,70 @@ update msg model = comments = Comment.update result model.comments in - { model + ( { model | debug = toString result , status = Commenting , comments = comments , comment = "" , parent = Nothing , user = { user | identity = getIdentity user } - } - ! [ timeoutEdits model.editTimeout result.id ] + } + , timeoutEdits model.editTimeout result.id + ) EditConfirm (Err error) -> - { model | debug = toString error } ! [] + ( { model | debug = toString error } + , Cmd.none + ) CommentDelete id -> - model - ! [ let - postReq = - Request.Comment.delete id model.user.identity - |> Http.toTask - in - Task.attempt DeleteConfirm postReq - ] + ( model + , let + postReq = + Request.Comment.delete id model.user.identity + |> Http.toTask + in + Task.attempt DeleteConfirm postReq + ) DeleteConfirm (Ok result) -> let comments = Comment.delete result model.comments in - { model + ( { model | debug = toString result , comments = comments - } - ! [] + } + , Cmd.none + ) DeleteConfirm (Err error) -> - { model | debug = toString error } ! [] + ( { model | debug = toString error } + , Cmd.none + ) CommentLike id -> - model - ! [ let - postReq = - Request.Comment.like id - |> Http.toTask - in - Task.attempt LikeConfirm postReq - ] + ( model + , let + postReq = + Request.Comment.like id + |> Http.toTask + in + Task.attempt LikeConfirm postReq + ) LikeConfirm (Ok result) -> let comments = Comment.like result model.comments in - { model + ( { model | debug = toString result , comments = comments - } - ! [] + } + , Cmd.none + ) LikeConfirm (Err error) -> let @@ -304,32 +351,34 @@ update msg model = _ -> toString error in - { model + ( { model | debug = print , comments = comments - } - ! [] + } + , Cmd.none + ) CommentDislike id -> - model - ! [ let - postReq = - Request.Comment.dislike id - |> Http.toTask - in - Task.attempt DislikeConfirm postReq - ] + ( model + , let + postReq = + Request.Comment.dislike id + |> Http.toTask + in + Task.attempt DislikeConfirm postReq + ) DislikeConfirm (Ok result) -> let comments = Comment.dislike result model.comments in - { model + ( { model | debug = toString result , comments = comments - } - ! [] + } + , Cmd.none + ) DislikeConfirm (Err error) -> let @@ -349,11 +398,12 @@ update msg model = _ -> toString error in - { model + ( { model | debug = print , comments = comments - } - ! [] + } + , Cmd.none + ) HardenEdit id -> let @@ -365,14 +415,18 @@ update msg model = _ -> Comment.readOnly id model.comments in - { model | comments = comments } ! [] + ( { model | comments = comments } + , Cmd.none + ) ToggleCommentVisibility id -> let comments = Comment.toggleVisible id model.comments in - { model | comments = comments } ! [] + ( { model | comments = comments } + , Cmd.none + ) subscriptions : Model -> Sub Msg @@ -395,6 +449,7 @@ dumbDecode val = Just decoded -> if decoded == "True" then True + else False diff --git a/app/elm/Util.elm b/app/elm/Util.elm index 937434fa..09d78908 100644 --- a/app/elm/Util.elm +++ b/app/elm/Util.elm @@ -8,12 +8,14 @@ import Time exposing (Time) (=>) : a -> b -> ( a, b ) (=>) = - (,) + \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 => @@ -33,6 +35,7 @@ stringToMaybe : String -> Maybe String stringToMaybe val = if String.isEmpty val then Nothing + else Just val diff --git a/app/elm/View.elm b/app/elm/View.elm index b552c344..2c808b3f 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -1,6 +1,6 @@ module View exposing (view) -import Data.Comment exposing (Comment, Responses(Responses), count) +import Data.Comment exposing (Comment, Responses(..), count) import Data.User exposing (Identity, getIdentity) import Html exposing (..) import Html.Attributes exposing (autocomplete, checked, cols, defaultValue, disabled, for, href, method, minlength, name, placeholder, rows, type_, value) @@ -15,6 +15,7 @@ import Time.DateTime.Distance exposing (inWords) import Util exposing (nothing, stringToMaybe) + {- Sync up stylsheets -} @@ -29,6 +30,7 @@ view model = toString model.count ++ (if model.count /= 1 then " comments" + else " comment" ) @@ -66,6 +68,7 @@ commentForm model commentId = Commenting -> if isNothing model.parent then model.comment + else "" @@ -83,12 +86,14 @@ commentForm model commentId = formDisable = if isNothing commentId && isJust model.parent then True + else False buttonDisable = if formDisable then True + else setButtonDisabled model.comment @@ -96,6 +101,7 @@ commentForm model commentId = if isNothing commentId then "Comment" --The main form is never a reply or update + else case model.status of Commenting -> @@ -118,6 +124,7 @@ commentForm model commentId = preview = if formDisable then nothing + else Markdown.toHtmlWith options [ id Style.OrationCommentPreview ] <| markdownContent model.comment model.user.preview @@ -158,6 +165,7 @@ setButtonDisabled : String -> Bool setButtonDisabled comment = if String.length comment > 3 then False + else True @@ -180,6 +188,7 @@ markdownContent : String -> Bool -> String markdownContent content preview = if preview then content + else "" @@ -203,6 +212,7 @@ printComment comment model = notDeleted = if String.isEmpty comment.text && String.isEmpty comment.hash then False + else True @@ -218,18 +228,21 @@ printComment comment model = headerStyle = if comment.hash == model.blogAuthor && notDeleted then [ Style.Thread, Style.BlogAuthor ] + else [ Style.Thread ] contentStyle = if comment.visible then [ Style.Comment ] + else [ Style.Hidden ] visibleButtonText = if comment.visible then "[–]" + else "[+" ++ toString (count <| List.singleton comment) ++ "]" in @@ -247,6 +260,7 @@ printComment comment model = , printResponses comment.children model ] ] + else li [ id commentId, class headerStyle ] [ span [ class [ Style.Deleted ] ] [ text "Deleted comment" ] @@ -261,6 +275,7 @@ printAuthor : String -> Html Msg printAuthor author = if String.startsWith "http://" author || String.startsWith "https://" author then a [ class [ Style.Author ], href author ] [ text author ] + else span [ class [ Style.Author ] ] [ text author ] @@ -311,24 +326,28 @@ printFooter status identity comment = votingDisabled = if comment.votable && comment.hash /= identity then False + else True edit = if comment.editable then button [ onClick (CommentEdit comment.id), disabled editDisabled ] [ text editText ] + else nothing delete = if comment.editable then button [ onClick (CommentDelete comment.id), disabled deleteDisabled ] [ text "delete" ] + else nothing votes = if comment.votes == 0 then " " + else " " ++ toString comment.votes in @@ -348,6 +367,7 @@ printResponses : Responses -> Model -> Html Msg printResponses (Responses responses) model = if List.isEmpty responses then nothing + else ul [] <| List.map (\c -> printComment c model) responses @@ -364,6 +384,7 @@ replyForm id model = Just val -> if id == val then commentForm model (Just id) + else nothing diff --git a/app/elm/elm-package.json b/app/elm/elm-package.json deleted file mode 100644 index 2fa5be5c..00000000 --- a/app/elm/elm-package.json +++ /dev/null @@ -1,29 +0,0 @@ -{ - "version": "0.1.0", - "summary": "A Rocket/Elm self hosted commenting system for static sites", - "repository": "https://github.com/Libbum/oration.git", - "license": "MIT", - "source-directories": [ - "." - ], - "exposed-modules": [], - "native-modules": true, - "dependencies": { - "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", - "elm-community/elm-time": "1.0.11 <= v < 2.0.0", - "elm-community/json-extra": "2.3.0 <= v < 3.0.0", - "elm-community/maybe-extra": "4.0.0 <= v < 5.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", - "ktonon/elm-crypto": "1.1.0 <= v < 2.0.0", - "lukewestby/elm-http-builder": "5.1.0 <= v < 6.0.0", - "pukkamustard/elm-identicon": "3.0.0 <= v < 4.0.0", - "rtfeldman/elm-css": "11.2.0 <= v < 12.0.0", - "rtfeldman/elm-css-helpers": "2.1.0 <= v < 3.0.0", - "scottcorgan/elm-css-normalize": "1.1.9 <= v < 2.0.0" - }, - "elm-version": "0.18.0 <= v < 0.19.0" -} diff --git a/app/elm/elm.json b/app/elm/elm.json new file mode 100644 index 00000000..3fe5f214 --- /dev/null +++ b/app/elm/elm.json @@ -0,0 +1,36 @@ +{ + "type": "application", + "source-directories": [ + "." + ], + "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-community/json-extra": "3.0.0", + "elm-community/elm-time": "1.0.11", + "elm-community/maybe-extra": "4.0.0", + "elm-lang/navigation": "2.1.0", + "ktonon/elm-crypto": "1.1.0", + "lukewestby/http-builder": "5.1.0", + "pukkamustard/elm-identicon": "3.0.0", + "rtfeldman/elm-css": "11.2.0", + "rtfeldman/elm-css-helpers": "2.1.0", + "scottcorgan/elm-css-normalize": "1.1.9" + }, + "indirect": { + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.0" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} \ No newline at end of file diff --git a/app/elm/tests/Helpers/Dates.elm b/app/elm/tests/Helpers/Dates.elm index 0af69a5a..ed6ee365 100644 --- a/app/elm/tests/Helpers/Dates.elm +++ b/app/elm/tests/Helpers/Dates.elm @@ -1,4 +1,4 @@ -module Helpers.Dates exposing (..) +module Helpers.Dates exposing (dateForYear, dateWithinYearRange) import Fuzz exposing (Fuzzer, int, intRange) import Time.Date exposing (isLeapYear) @@ -11,6 +11,7 @@ dateForYear year = daysUpper = if isLeapYear year then 365 + else 364 in diff --git a/app/elm/tests/Tests.elm b/app/elm/tests/Tests.elm index 6537e04e..4931869b 100644 --- a/app/elm/tests/Tests.elm +++ b/app/elm/tests/Tests.elm @@ -1,6 +1,6 @@ -module Tests exposing (..) +module Tests exposing (all, dateNear, user) -import Data.Comment exposing (Comment, Responses(Responses)) +import Data.Comment exposing (Comment, Responses(..)) import Data.User exposing (User) import Expect exposing (..) import Fuzz exposing (Fuzzer, bool, int, list, maybe, string, tuple)