From 5d43fbfe78af376722e3ba3cbe8cd8737dfde5d0 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Wed, 6 Apr 2022 17:21:45 +0200 Subject: [PATCH] use Set and not List to model tags --- elm/src/Logged.elm | 22 ++++++++++++---------- elm/src/LoggedModel.elm | 9 +++++---- elm/src/Main.elm | 3 ++- elm/src/Tags.elm | 28 ++++++++++------------------ 4 files changed, 29 insertions(+), 33 deletions(-) diff --git a/elm/src/Logged.elm b/elm/src/Logged.elm index c176f16..60ba5fc 100644 --- a/elm/src/Logged.elm +++ b/elm/src/Logged.elm @@ -6,6 +6,9 @@ import LoggedModel exposing (..) import Style exposing (..) import Tags exposing (..) +-- elm/core +import Set exposing (..) + -- elm/http import Http exposing (..) @@ -65,7 +68,7 @@ viewTag tag = Element.el [ normalPadding , normalSpacing ] - ( Element.text tag.name ) + ( Element.text tag ) view : Model -> Element Msg view model = Component.mainRow @@ -87,7 +90,7 @@ view model = Component.mainRow , width = fill , view = \content -> Element.el tableRowStyle - ( row [] ( List.map viewTag content.tags ) ) } + ( row [] ( List.map viewTag ( toList content.tags ) ) ) } ] } ] @@ -106,17 +109,17 @@ view model = Component.mainRow -- HTTP -retrieveUrl : List Tag -> String +retrieveUrl : Set Tag -> String retrieveUrl tags = Url.Builder.custom ( CrossOrigin "http://localhost:8080" ) [ "get-contents" ] - ( List.map ( \tag -> Url.Builder.string "tag" tag.name ) tags ) + ( List.map ( \tag -> Url.Builder.string "tag" tag ) ( toList tags ) ) Nothing authorization : Token -> Header authorization token = Http.header "Authorization" ( String.append "Bearer " token ) -retrieveContents : Token -> List Tag -> Cmd Msg +retrieveContents : Token -> Set Tag -> Cmd Msg retrieveContents token tags = Http.request { method = "GET" , headers = [ authorization token ] @@ -133,13 +136,12 @@ handleContentsResponse result = case result of Err error -> FetchFailed error tagDecoder : Decoder Tag -tagDecoder = Json.Decode.map Tag - ( field "name" Json.Decode.string ) +tagDecoder = field "name" Json.Decode.string contentDecoder : Decoder Content contentDecoder = map2 Content ( field "message" Json.Decode.string ) - ( field "tags" ( Json.Decode.list ( Json.Decode.map Tag Json.Decode.string ))) + ( field "tags" ( Json.Decode.map fromList ( Json.Decode.list ( Json.Decode.string ) ) ) ) wrappedContentDecoder : Decoder Content wrappedContentDecoder = Json.Decode.map identity @@ -162,10 +164,10 @@ handleNewContentResponse content result = case result of Ok () -> SubmitSuccessful content tagEncoder : Tag -> Json.Encode.Value -tagEncoder tag = Json.Encode.string tag.name +tagEncoder tag = Json.Encode.string tag contentEncoder : Content -> Json.Encode.Value contentEncoder content = Json.Encode.object [ ( "message", Json.Encode.string content.message ) - , ( "tags", Json.Encode.list tagEncoder content.tags) + , ( "tags", Json.Encode.list tagEncoder ( toList content.tags ) ) ] diff --git a/elm/src/LoggedModel.elm b/elm/src/LoggedModel.elm index e9c1680..769a740 100644 --- a/elm/src/LoggedModel.elm +++ b/elm/src/LoggedModel.elm @@ -1,10 +1,11 @@ module LoggedModel exposing (..) -type alias Tag = - { name : String - } +-- elm/core +import Set exposing (..) + +type alias Tag = String type alias Content = { message : String - , tags : List Tag + , tags : Set Tag } diff --git a/elm/src/Main.elm b/elm/src/Main.elm index 7064787..9cab958 100644 --- a/elm/src/Main.elm +++ b/elm/src/Main.elm @@ -10,6 +10,7 @@ import Style exposing (..) import Browser exposing (..) -- elm/core +import Set exposing (..) import Tuple exposing (mapBoth) -- mdgriffith/elm-ui @@ -42,7 +43,7 @@ type Msg updateAnonymous : Anonymous.Msg -> Anonymous.Model -> ( Model, Cmd Msg ) updateAnonymous msg anonymousModel = case msg of - Login ( Succeeded token ) -> ( LoggedIn ( Logged.init token ), Cmd.map LoggedInMsg ( retrieveContents token [] ) ) + Login ( Succeeded token ) -> ( LoggedIn ( Logged.init token ), Cmd.map LoggedInMsg ( retrieveContents token empty ) ) _ -> Tuple.mapBoth Anonymous ( Cmd.map AnonymousMsg ) (Anonymous.update msg anonymousModel) update : Msg -> Model -> ( Model, Cmd Msg ) diff --git a/elm/src/Tags.elm b/elm/src/Tags.elm index 351bcb2..ec0d028 100644 --- a/elm/src/Tags.elm +++ b/elm/src/Tags.elm @@ -4,6 +4,9 @@ import Component exposing (..) import LoggedModel exposing (..) import Style exposing (..) +-- elm/core +import Set exposing (..) + -- mdgriffith/elm-ui import Element exposing (..) import Element.Background exposing (..) @@ -16,11 +19,11 @@ import Element.Input exposing (labelAbove) type alias Model = { newTag : String - , tags : List Tag + , tags : Set Tag } init : Model -init = Model "" [] +init = Model "" empty -- UPDATE @@ -29,31 +32,20 @@ type Msg | Submit | Remove String -update : ( List Tag -> Cmd msg ) -> Msg -> Model -> ( Model, Cmd msg ) +update : ( Set Tag -> Cmd msg ) -> Msg -> Model -> ( Model, Cmd msg ) update onSubmit msg model = case msg of NewTag newTag -> ( { model | newTag = newTag }, Cmd.none ) Submit -> let - tags = ( Tag model.newTag ) :: model.tags + tags = insert model.newTag model.tags in ( { model | newTag = "", tags = tags }, onSubmit tags ) Remove id -> let - tags = removeTag id model.tags + tags = remove id model.tags in ( { model | tags = tags }, onSubmit tags ) -removeTag : String -> List Tag -> List Tag -removeTag id tags = remove ( Tag id ) tags - -remove : a -> List a -> List a -remove value list = case list of - [] -> [] - ( head :: tail ) -> - if head == value - then remove value tail - else head :: remove value tail - -- VIEW removable : String -> Element Msg -> Element Msg @@ -66,7 +58,7 @@ removable id element = row ] viewRemovableTag : ( Tag -> Element Msg ) -> Tag -> Element Msg -viewRemovableTag viewTag tag = removable tag.name ( viewTag tag ) +viewRemovableTag viewTag tag = removable tag ( viewTag tag ) view : ( Tag -> Element Msg ) -> String -> String -> Model -> Element Msg view viewTag label submitText model = column @@ -80,5 +72,5 @@ view viewTag label submitText model = column , label = labelAbove [] ( Element.text label ) } ) , Component.button Submit submitText - , Element.row [ normalSpacing ] ( List.map (viewRemovableTag viewTag) model.tags ) + , Element.row [ normalSpacing ] ( List.map (viewRemovableTag viewTag) ( toList model.tags ) ) ]