diff --git a/.gitignore b/.gitignore
index a1a00e9..3d2a934 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
node_modules
elm-stuff
+.idea/
diff --git a/elm.json b/elm.json
index 00529a5..88f55cc 100644
--- a/elm.json
+++ b/elm.json
@@ -6,10 +6,12 @@
"elm-version": "0.19.1",
"dependencies": {
"direct": {
+ "NoRedInk/elm-json-decode-pipeline": "1.0.1",
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0",
- "elm/json": "1.1.3"
+ "elm/json": "1.1.3",
+ "elm/regex": "1.0.0"
},
"indirect": {
"elm/time": "1.0.0",
diff --git a/index.html b/index.html
index 58b82c5..1ff3c0b 100644
--- a/index.html
+++ b/index.html
@@ -3,6 +3,7 @@
+
Elm challenge
diff --git a/src/Components/Input.elm b/src/Components/Input.elm
new file mode 100644
index 0000000..5d2208e
--- /dev/null
+++ b/src/Components/Input.elm
@@ -0,0 +1,133 @@
+module Components.Input exposing
+ ( disabled
+ , error
+ , id
+ , label
+ , onBlur
+ , onChange
+ , type_
+ , value
+ , viewTextOrNumber
+ )
+
+import Html exposing (Html)
+import Html.Attributes as Attrs
+import Html.Events as Events
+
+
+type alias Config msg =
+ { label : String
+ , disabled : Bool
+ , type_ : String
+ , onChange : Maybe (String -> msg)
+ , onBlur : Maybe msg
+ , value : String
+ , error : String
+ , id : String
+ }
+
+
+defaultConfig : Config msg
+defaultConfig =
+ { label = ""
+ , disabled = False
+ , type_ = "text"
+ , onChange = Nothing
+ , onBlur = Nothing
+ , value = ""
+ , error = ""
+ , id = ""
+ }
+
+
+id : String -> Config msg -> Config msg
+id id_ config =
+ { config | id = id_ }
+
+
+onBlur : Maybe msg -> Config msg -> Config msg
+onBlur onBlur_ config =
+ { config | onBlur = onBlur_ }
+
+
+label : String -> Config msg -> Config msg
+label label_ config =
+ { config | label = label_ }
+
+
+disabled : Bool -> Config msg -> Config msg
+disabled disabled_ config =
+ { config | disabled = disabled_ }
+
+
+type_ : String -> Config msg -> Config msg
+type_ type__ config =
+ { config | type_ = type__ }
+
+
+onChange : Maybe (String -> msg) -> Config msg -> Config msg
+onChange onChange_ config =
+ { config | onChange = onChange_ }
+
+
+value : String -> Config msg -> Config msg
+value value_ config =
+ { config | value = value_ }
+
+
+error : String -> Config msg -> Config msg
+error error_ config =
+ { config | error = error_ }
+
+
+viewTextOrNumber : List (Config msg -> Config msg) -> Html msg
+viewTextOrNumber customConfigurations =
+ let
+ config : Config msg
+ config =
+ customConfigurations
+ |> List.foldl
+ (\customConfiguration config_ -> customConfiguration config_)
+ defaultConfig
+
+ hasError : Bool
+ hasError =
+ not (String.isEmpty config.error)
+ in
+ Html.span
+ [ Attrs.class "flex flex-col rounded px-2 py-1"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", config.disabled ) ]
+ ]
+ [ Html.label [ Attrs.class "text-sm pl-1", Attrs.classList [ ( "text-red-500", hasError ) ] ]
+ [ Html.text
+ (if hasError then
+ config.error
+
+ else
+ config.label
+ )
+ ]
+ , Html.input
+ ([ Attrs.type_ config.type_
+ , Attrs.id config.id
+ , Attrs.class "focus:outline-none w-full"
+ , Attrs.class "border rounded px-2 py-1"
+ , Attrs.classList
+ [ ( "bg-[#e8f3fc]", config.disabled )
+ , ( "border-red-500", hasError )
+ , ( "border-stone-400", not hasError )
+ ]
+ , Attrs.disabled config.disabled
+ , Attrs.value config.value
+ ]
+ ++ (config.onChange
+ |> Maybe.map (Events.onInput >> List.singleton)
+ |> Maybe.withDefault []
+ )
+ ++ (config.onBlur
+ |> Maybe.map (Events.onBlur >> List.singleton)
+ |> Maybe.withDefault []
+ )
+ )
+ []
+ ]
diff --git a/src/Main.elm b/src/Main.elm
index fd56972..3d613de 100644
--- a/src/Main.elm
+++ b/src/Main.elm
@@ -2,8 +2,35 @@ module Main exposing (main)
import Browser
import Data
+import Dict exposing (Dict)
import Html exposing (Html)
import Html.Attributes as Attrs
+import Html.Events as Events
+import Json.Decode as Decode
+import Json.Decode.Pipeline as Decode
+import Modules.Contact as Contact
+import Modules.Settings as Settings exposing (Settings)
+import Modules.Tags as Tags
+
+
+
+---- PROGRAM ----
+
+
+main : Program () Model Msg
+main =
+ Browser.application
+ { view =
+ \model ->
+ { title = "Scrive elm challenge task"
+ , body = [ view model ]
+ }
+ , init = \_ _ _ -> init
+ , update = update
+ , subscriptions = always Sub.none
+ , onUrlRequest = always NoOp
+ , onUrlChange = always NoOp
+ }
@@ -11,12 +38,117 @@ import Html.Attributes as Attrs
type alias Model =
- {}
+ { userGroup : UserGroup
+ , currentForm : Maybe Form
+ , contactForm : Contact.Model
+ , settingsForm : Settings.Model
+ , tagsForm : Tags.Model
+ }
+
+
+type Form
+ = SettingsForm
+ | ContactForm
+ | TagsForm
+
+
+
+-- User Group
+
+
+type alias UserGroup =
+ { id : String
+ , parentId : String
+ , name : String
+ , children : List Children
+ , settings : Settings
+ , contactDetails : Contact.Details
+ , tags : Dict String String
+ }
+
+
+emptyUserGroup : UserGroup
+emptyUserGroup =
+ { id = ""
+ , parentId = ""
+ , name = ""
+ , children = []
+ , settings = Settings.empty
+ , contactDetails = Contact.empty
+ , tags = Dict.empty
+ }
+
+
+userGroupDecoder : Decode.Decoder UserGroup
+userGroupDecoder =
+ Decode.succeed UserGroup
+ |> Decode.required "id" Decode.string
+ |> Decode.optional "parent_id" Decode.string ""
+ |> Decode.required "name" Decode.string
+ |> Decode.required "children" (Decode.list childrenDecoder)
+ |> Decode.required "settings" Settings.decoder
+ |> Decode.required "contact_details" Contact.decoder
+ |> Decode.required "tags"
+ (Decode.map
+ (\tags ->
+ tags
+ |> List.map (\tag -> ( tag.name, tag.value ))
+ |> Dict.fromList
+ )
+ (Decode.list Tags.decoder)
+ )
+
+
+type alias Children =
+ { id : String
+ , name : String
+ }
+
+
+childrenDecoder : Decode.Decoder Children
+childrenDecoder =
+ Decode.succeed Children
+ |> Decode.required "id" Decode.string
+ |> Decode.required "name" Decode.string
+
+
+
+-- Settings
init : ( Model, Cmd Msg )
init =
- ( {}, Cmd.none )
+ let
+ userGroup : UserGroup
+ userGroup =
+ Decode.decodeString userGroupDecoder Data.userGroup
+ |> Result.toMaybe
+ |> Maybe.withDefault emptyUserGroup
+ in
+ ( { userGroup = userGroup
+ , currentForm = Nothing
+ , contactForm =
+ Contact.initialModel
+ userGroup.contactDetails.address
+ { isInherited =
+ not (String.isEmpty userGroup.contactDetails.inheritedFrom)
+ && not (String.isEmpty userGroup.parentId)
+ }
+ , settingsForm =
+ Settings.initialModel
+ userGroup.settings.dataRetentionPolicy
+ { isInherited =
+ not (String.isEmpty userGroup.settings.inheritedFrom)
+ && not (String.isEmpty userGroup.parentId)
+ }
+ , tagsForm =
+ Tags.initialModel
+ { tags = userGroup.tags
+ , isInherited = not (String.isEmpty userGroup.parentId)
+ }
+ }
+ , Cmd.none
+ )
@@ -25,55 +157,356 @@ init =
type Msg
= NoOp
+ | ContactFormMsg Contact.Msg
+ | ContactSubmitted Contact.Model
+ | ContactEditClicked
+ | FormClosed
+ | SettingsFormMsg Settings.Msg
+ | SettingsSubmitted Settings.Model
+ | SettingsEditClicked
+ | TagsFormMsg Tags.Msg
+ | TagsSubmitted Tags.Model
+ | TagsEditClicked
update : Msg -> Model -> ( Model, Cmd Msg )
-update _ model =
- ( model, Cmd.none )
+update msg ({ userGroup } as model) =
+ case msg of
+ NoOp ->
+ ( model, Cmd.none )
+ ContactFormMsg contactMsg ->
+ let
+ ( contactForm, contactCmd ) =
+ Contact.update contactMsg
+ model.contactForm
+ { onSubmit = ContactSubmitted
+ , onClose = FormClosed
+ }
+ in
+ ( { model | contactForm = contactForm }
+ , contactCmd
+ )
+ ContactSubmitted contact ->
+ let
+ newAddressDetails : Contact.Address
+ newAddressDetails =
+ { preferredContactMethod = contact.preferredContactMethod
+ , email = contact.email
+ , phone = contact.phone
+ , companyName = contact.companyName
+ , address = contact.address
+ , zip = contact.zip
+ , city = contact.city
+ , country = contact.country
+ }
----- VIEW ----
+ toNewContactDetails : Contact.Details -> Contact.Details
+ toNewContactDetails contactDetails =
+ { contactDetails | address = newAddressDetails }
+ in
+ ( { model
+ | currentForm = Nothing
+ , userGroup =
+ { userGroup
+ | contactDetails =
+ toNewContactDetails userGroup.contactDetails
+ }
+ , contactForm =
+ Contact.initialModel
+ newAddressDetails
+ { isInherited = model.contactForm.isInherited }
+ }
+ , Cmd.none
+ )
+
+ ContactEditClicked ->
+ ( { model | currentForm = Just ContactForm }
+ , Cmd.none
+ )
+
+ FormClosed ->
+ ( { model
+ | currentForm = Nothing
+ , contactForm =
+ Contact.initialModel
+ userGroup.contactDetails.address
+ { isInherited = model.contactForm.isInherited }
+ , settingsForm =
+ Settings.initialModel
+ userGroup.settings.dataRetentionPolicy
+ { isInherited = model.settingsForm.isInherited }
+ , tagsForm =
+ Tags.initialModel
+ { tags = userGroup.tags
+ , isInherited = model.tagsForm.isInherited
+ }
+ }
+ , Cmd.none
+ )
+
+ SettingsFormMsg settingsMsg ->
+ let
+ ( settingsForm, settingsCmd ) =
+ Settings.update settingsMsg
+ model.settingsForm
+ { onSubmit = SettingsSubmitted
+ , onClose = FormClosed
+ , onFocus = NoOp
+ }
+ in
+ ( { model | settingsForm = settingsForm }
+ , settingsCmd
+ )
+
+ SettingsSubmitted settings ->
+ let
+ newDataRetentionPolicy : Settings.DataRetentionPolicy
+ newDataRetentionPolicy =
+ { idleDocTimeOutPreparation = settings.idleDocTimeOutPreparation
+ , idleDocTimeOutClosed = settings.idleDocTimeOutClosed
+ , idleDocTimeOutCancelled = settings.idleDocTimeOutCancelled
+ , idleDocTimeOutTimedOut = settings.idleDocTimeOutTimedOut
+ , idleDocTimeOutRejected = settings.idleDocTimeOutRejected
+ , idleDocTimeOutError = settings.idleDocTimeOutError
+ , immediateTrash = settings.immediateTrash
+ }
+
+ toNewSettings : Settings -> Settings
+ toNewSettings settings_ =
+ { settings_ | dataRetentionPolicy = newDataRetentionPolicy }
+ in
+ ( { model
+ | currentForm = Nothing
+ , settingsForm =
+ Settings.initialModel
+ newDataRetentionPolicy
+ { isInherited = model.settingsForm.isInherited }
+ , userGroup =
+ { userGroup
+ | settings =
+ toNewSettings userGroup.settings
+ }
+ }
+ , Cmd.none
+ )
+
+ SettingsEditClicked ->
+ ( { model | currentForm = Just SettingsForm }, Cmd.none )
+ TagsFormMsg tagsMsg ->
+ let
+ ( tagsForm, tagsCmd ) =
+ Tags.update tagsMsg
+ model.tagsForm
+ { onSubmit = TagsSubmitted
+ , onClose = FormClosed
+ , onFocus = NoOp
+ }
+ in
+ ( { model | tagsForm = tagsForm }
+ , tagsCmd
+ )
-header : String -> Html msg
-header text =
- Html.span [ Attrs.class "p-2 text-5xl font-extrabold text-transparent bg-clip-text bg-gradient-to-br from-slate-400 to-slate-800" ]
- [ Html.text text ]
+ TagsSubmitted tags ->
+ let
+ newTags : Dict String String
+ newTags =
+ tags.tags
+ |> Dict.values
+ |> List.map (\{ name, value } -> ( name, value ))
+ |> Dict.fromList
+ toNewTags : UserGroup
+ toNewTags =
+ { userGroup | tags = newTags }
+ in
+ ( { model
+ | currentForm = Nothing
+ , userGroup = toNewTags
+ , tagsForm =
+ Tags.initialModel
+ { tags = newTags
+ , isInherited = model.tagsForm.isInherited
+ }
+ }
+ , Cmd.none
+ )
-subheader : String -> Html msg
-subheader text =
- Html.span [ Attrs.class "p-2 text-2xl font-extrabold text-slate-800" ]
- [ Html.text text ]
+ TagsEditClicked ->
+ ( { model | currentForm = Just TagsForm }
+ , Cmd.none
+ )
+
+
+
+---- VIEW ----
view : Model -> Html Msg
-view _ =
- Html.div [ Attrs.class "flex flex-col w-[1024px] items-center mx-auto mt-16 mb-48" ]
- [ header "Let's start your task"
- , subheader "Here are your data:"
- , Html.pre [ Attrs.class "my-8 py-4 px-12 text-sm bg-slate-100 font-mono shadow rounded" ] [ Html.text Data.userGroup ]
- , header "Now turn them into form."
- , subheader "See README for details of the task. Good luck 🍀 "
+view { userGroup, currentForm, contactForm, settingsForm, tagsForm } =
+ Html.div [ Attrs.class "flex flex-col items-center font-montserrat" ]
+ (currentForm
+ |> Maybe.map
+ (\form ->
+ case form of
+ ContactForm ->
+ [ Contact.view contactForm |> Html.map ContactFormMsg ]
+
+ SettingsForm ->
+ [ Settings.view settingsForm |> Html.map SettingsFormMsg ]
+
+ TagsForm ->
+ [ Tags.view tagsForm |> Html.map TagsFormMsg ]
+ )
+ |> Maybe.withDefault
+ [ Html.div [ Attrs.class "flex flex-col text-left my-2 w-full sm:w-3/6 border rounded" ]
+ [ Html.h1
+ [ Attrs.class "text-lg mb-2 bg-stone-100 border-b p-2.5" ]
+ [ Html.text "Group Details:" ]
+ , Html.h2
+ [ Attrs.class "text-md w-full p-2.5" ]
+ [ Html.text userGroup.name ]
+ ]
+ , viewContact userGroup.contactDetails
+ , viewSettings userGroup.settings
+ , viewTags { tags = userGroup.tags }
+ , Html.div [ Attrs.class "flex flex-col text-left my-2 w-full sm:w-3/6 border rounded" ]
+ [ Html.h1 [ Attrs.class "text-lg p-2.5 w-full" ] [ Html.text "Child groups:" ]
+ , Html.span []
+ (userGroup.children
+ |> List.map
+ (\childGroup ->
+ Html.div [ Attrs.class "text-md p-2.5 w-full bg-stone-100 mb-1 " ]
+ [ Html.text childGroup.name ]
+ )
+ )
+ ]
+ ]
+ )
+
+
+viewTags : { tags : Dict String String } -> Html Msg
+viewTags { tags } =
+ Html.div [ Attrs.class "flex flex-col text-left my-2 w-full sm:w-3/6 border rounded p-2.5 gap-4" ]
+ ([ Html.div [ Attrs.class "w-full flex flex-row justify-between gap-4 border-b pb-2" ]
+ [ Html.h1 [ Attrs.class "text-lg font-semibold text-stone-800" ] [ Html.text "Tags" ]
+ , Html.button
+ [ Attrs.class "border border-transparent rounded px-2 py-1"
+ , Attrs.class "bg-[#1e88e2] text-white outline-black hover:text-[#d2e7f9]"
+ , Events.onClick TagsEditClicked
+ ]
+ [ Html.text "edit" ]
+ ]
+ ]
+ ++ (if Dict.isEmpty tags then
+ [ Html.p [] [ Html.text "No tags found." ] ]
+
+ else
+ [ Html.div [ Attrs.class "flex flex-wrap overflow-hidden gap-4" ]
+ (tags
+ |> Dict.toList
+ |> List.map
+ (\( name, value ) ->
+ Html.p [ Attrs.class "bg-[#e8f3fc] w-fit p-1 rounded ellipsis" ]
+ [ Html.text
+ ([ name, value ]
+ |> List.filter (not << String.isEmpty)
+ |> String.join " : "
+ )
+ ]
+ )
+ )
+ ]
+ )
+ )
+
+
+viewSettings : Settings -> Html Msg
+viewSettings { dataRetentionPolicy } =
+ Html.div
+ [ Attrs.class "flex flex-col text-left my-2 w-full"
+ , Attrs.class "sm:w-3/6 border rounded p-2.5 gap-4"
]
+ ([ Html.div [ Attrs.class "w-full flex flex-row justify-between gap-4 border-b pb-2" ]
+ [ Html.h1 [ Attrs.class "text-lg font-semibold text-stone-800" ] [ Html.text "Settings" ]
+ , Html.button
+ [ Attrs.class "border border-transparent rounded px-2 py-1"
+ , Attrs.class "bg-[#1e88e2] text-white outline-black hover:text-[#d2e7f9]"
+ , Events.onClick SettingsEditClicked
+ ]
+ [ Html.text "edit" ]
+ ]
+ , Html.h1
+ [ Attrs.class "text-md font-semibold text-stone-800" ]
+ [ Html.text "Data retention policy:" ]
+ ]
+ ++ (Settings.activePolicies dataRetentionPolicy
+ |> List.map
+ (\( policy, value ) ->
+ Html.div [ Attrs.class "w-full flex flex-row gap-4" ]
+ [ Html.p [] [ Html.text (Settings.policyToString policy ++ ":") ]
+ , Html.p [] [ Html.text (String.fromInt value) ]
+ ]
+ )
+ )
+ ++ [ Html.div [ Attrs.class "w-full flex flex-row gap-4" ]
+ [ Html.p [] [ Html.text "immediate trash:" ]
+ , Html.p []
+ [ Html.text
+ (if dataRetentionPolicy.immediateTrash then
+ "yes"
+ else
+ "no"
+ )
+ ]
+ ]
+ ]
+ )
----- PROGRAM ----
+viewContact : Contact.Details -> Html Msg
+viewContact contactDetails =
+ Html.div
+ [ Attrs.class "flex flex-col text-left my-2 w-full"
+ , Attrs.class "sm:w-3/6 border rounded p-2.5 gap-4"
+ ]
+ [ Html.div [ Attrs.class "w-full flex flex-row justify-between gap-4 border-b pb-2" ]
+ [ Html.h1 [ Attrs.class "text-lg font-semibold text-stone-800" ] [ Html.text "Contact" ]
+ , Html.button
+ [ Attrs.class "border border-transparent rounded px-2 py-1"
+ , Attrs.class "bg-[#1e88e2] text-white outline-black hover:text-[#d2e7f9]"
+ , Events.onClick ContactEditClicked
+ ]
+ [ Html.text "edit" ]
+ ]
+ , Html.div [ Attrs.class "w-full flex flex-col" ]
+ ([ Html.p [ Attrs.class "text-md font-semibold text-stone-800" ]
+ [ Html.text contactDetails.address.companyName ]
+ ]
+ ++ (case contactDetails.address.preferredContactMethod of
+ Contact.Email ->
+ [ Html.p [ Attrs.class "text-md font-semibold text-stone-800" ]
+ [ Html.text contactDetails.address.email ]
+ ]
+ Contact.Phone ->
+ [ Html.p [ Attrs.class "text-md font-semibold text-stone-800" ]
+ [ Html.text contactDetails.address.phone ]
+ ]
-main : Program () Model Msg
-main =
- Browser.application
- { view =
- \model ->
- { title = "Scrive elm challenge task"
- , body = [ view model ]
- }
- , init = \_ _ _ -> init
- , update = update
- , subscriptions = always Sub.none
- , onUrlRequest = always NoOp
- , onUrlChange = always NoOp
- }
+ Contact.Post ->
+ [ Html.p [ Attrs.class "text-md font-semibold text-stone-800" ]
+ [ Html.text contactDetails.address.address ]
+ , Html.p [ Attrs.class "text-md font-semibold text-stone-800" ]
+ [ Html.text contactDetails.address.zip ]
+ , Html.p [ Attrs.class "text-md font-semibold text-stone-800" ]
+ [ Html.text contactDetails.address.city ]
+ , Html.p [ Attrs.class "text-md font-semibold text-stone-800" ]
+ [ Html.text contactDetails.address.country ]
+ ]
+ )
+ )
+ ]
diff --git a/src/Modules/Contact.elm b/src/Modules/Contact.elm
new file mode 100644
index 0000000..b3103c4
--- /dev/null
+++ b/src/Modules/Contact.elm
@@ -0,0 +1,531 @@
+module Modules.Contact exposing
+ ( Address
+ , Details
+ , Model
+ , Msg
+ , PreferredContactMethod(..)
+ , decoder
+ , empty
+ , initialModel
+ , update
+ , view
+ )
+
+import Components.Input as Input
+import Html exposing (Html)
+import Html.Attributes as Attrs
+import Html.Events as Events
+import Json.Decode as Decode
+import Json.Decode.Pipeline as Decode
+import Regex
+import Task
+
+
+type alias Model =
+ { preferredContactMethod : PreferredContactMethod
+ , email : String
+ , phone : String
+ , companyName : String
+ , address : String
+ , zip : String
+ , city : String
+ , country : String
+ , isInherited : Bool
+ , error : ContactFormError
+ }
+
+
+type PreferredContactMethod
+ = Email
+ | Phone
+ | Post
+
+
+preferredContactMethodDecoder : Decode.Decoder PreferredContactMethod
+preferredContactMethodDecoder =
+ Decode.string
+ |> Decode.andThen
+ (\method ->
+ case method of
+ "email" ->
+ Decode.succeed Email
+
+ "phone" ->
+ Decode.succeed Phone
+
+ "letter" ->
+ Decode.succeed Post
+
+ _ ->
+ Decode.fail "Not valid contact method"
+ )
+
+
+contactMethodToString : PreferredContactMethod -> String
+contactMethodToString method =
+ case method of
+ Email ->
+ "email"
+
+ Phone ->
+ "phone"
+
+ Post ->
+ "post"
+
+
+allContactMethods : List PreferredContactMethod
+allContactMethods =
+ toAllContactMethods Email []
+
+
+toAllContactMethods : PreferredContactMethod -> List PreferredContactMethod -> List PreferredContactMethod
+toAllContactMethods method methods =
+ case method of
+ Email ->
+ toAllContactMethods Phone (Email :: methods)
+
+ Phone ->
+ toAllContactMethods Post (Phone :: methods)
+
+ Post ->
+ Post :: methods
+
+
+type alias Details =
+ { inheritedFrom : String
+ , address : Address
+ }
+
+
+empty : Details
+empty =
+ { inheritedFrom = ""
+ , address = emptyAddress
+ }
+
+
+decoder : Decode.Decoder Details
+decoder =
+ Decode.succeed Details
+ |> Decode.optional "inherited_from" Decode.string ""
+ |> Decode.required "address" addressDecoder
+
+
+type alias Address =
+ { preferredContactMethod : PreferredContactMethod
+ , email : String
+ , phone : String
+ , companyName : String
+ , address : String
+ , zip : String
+ , city : String
+ , country : String
+ }
+
+
+emptyAddress : Address
+emptyAddress =
+ { preferredContactMethod = Email
+ , email = ""
+ , phone = ""
+ , companyName = ""
+ , address = ""
+ , zip = ""
+ , city = ""
+ , country = ""
+ }
+
+
+addressDecoder : Decode.Decoder Address
+addressDecoder =
+ Decode.succeed Address
+ |> Decode.required "preferred_contact_method" preferredContactMethodDecoder
+ |> Decode.optional "email" Decode.string ""
+ |> Decode.optional "phone" Decode.string ""
+ |> Decode.optional "company_name" Decode.string ""
+ |> Decode.optional "address" Decode.string ""
+ |> Decode.optional "zip" Decode.string ""
+ |> Decode.optional "city" Decode.string ""
+ |> Decode.optional "country" Decode.string ""
+
+
+type alias ContactFormError =
+ Maybe ( ContactFormField, String )
+
+
+type ContactFormField
+ = EmailField
+ | PhoneField
+ | AddressField
+ | ZipField
+ | CityField
+ | CountryField
+
+
+errorToMessage : ContactFormField -> ( ContactFormField, String ) -> String
+errorToMessage field error =
+ if Tuple.first error == field then
+ Tuple.second error
+
+ else
+ ""
+
+
+initialModel :
+ { preferredContactMethod : PreferredContactMethod
+ , email : String
+ , phone : String
+ , companyName : String
+ , address : String
+ , zip : String
+ , city : String
+ , country : String
+ }
+ -> { isInherited : Bool }
+ -> Model
+initialModel address { isInherited } =
+ { preferredContactMethod = address.preferredContactMethod
+ , email = address.email
+ , phone = address.phone
+ , companyName = address.companyName
+ , address = address.address
+ , zip = address.zip
+ , city = address.city
+ , country = address.country
+ , isInherited = isInherited
+ , error = Nothing
+ }
+
+
+type Msg
+ = PreferredContactMethodChanged PreferredContactMethod
+ | EmailChanged String
+ | PhoneChanged String
+ | CompanyNameChanged String
+ | AddressChanged String
+ | ZipChanged String
+ | CityChanged String
+ | CountryChanged String
+ | Submitted
+ | Closed
+
+
+update : Msg -> Model -> { onSubmit : Model -> msg, onClose : msg } -> ( Model, Cmd msg )
+update msg model config =
+ case msg of
+ PreferredContactMethodChanged method ->
+ ( { model | preferredContactMethod = method }
+ , Cmd.none
+ )
+
+ EmailChanged email ->
+ ( { model | email = email }
+ , Cmd.none
+ )
+
+ PhoneChanged phone ->
+ ( { model | phone = phone }
+ , Cmd.none
+ )
+
+ CompanyNameChanged companyName ->
+ ( { model | companyName = companyName }
+ , Cmd.none
+ )
+
+ AddressChanged address ->
+ ( { model | address = address }
+ , Cmd.none
+ )
+
+ ZipChanged zip ->
+ ( { model | zip = zip }
+ , Cmd.none
+ )
+
+ CityChanged city ->
+ ( { model | city = city }
+ , Cmd.none
+ )
+
+ CountryChanged country ->
+ ( { model | country = country }
+ , Cmd.none
+ )
+
+ Submitted ->
+ let
+ error : Maybe ( ContactFormField, String )
+ error =
+ case model.preferredContactMethod of
+ Email ->
+ emailError model.email
+
+ Phone ->
+ phoneError model.phone
+
+ Post ->
+ postError
+ { address = model.address
+ , zip = model.zip
+ , city = model.city
+ , country = model.country
+ }
+ in
+ case error of
+ Nothing ->
+ ( { model | error = Nothing }
+ , Task.perform config.onSubmit (Task.succeed model)
+ )
+
+ Just _ ->
+ ( { model | error = error }
+ , Cmd.none
+ )
+
+ Closed ->
+ ( { model | error = Nothing }
+ , Task.perform (\_ -> config.onClose) (Task.succeed "")
+ )
+
+
+postError :
+ { address : String
+ , zip : String
+ , city : String
+ , country : String
+ }
+ -> Maybe ( ContactFormField, String )
+postError { address, zip, city, country } =
+ if String.isEmpty address then
+ Just ( AddressField, "address is required" )
+
+ else if String.isEmpty zip then
+ Just ( ZipField, "zip is required" )
+
+ else if String.isEmpty city then
+ Just ( CityField, "city is required" )
+
+ else if String.isEmpty country then
+ Just ( CountryField, "country is required" )
+
+ else
+ Nothing
+
+
+emailError : String -> Maybe ( ContactFormField, String )
+emailError email =
+ let
+ emailRegex : Regex.Regex
+ emailRegex =
+ Maybe.withDefault
+ Regex.never
+ (Regex.fromString "^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\\.[a-zA-Z]{2,}$")
+ in
+ if String.isEmpty email then
+ Just ( EmailField, "email cannot be empty." )
+
+ else if not (Regex.contains emailRegex email) then
+ Just ( EmailField, "invalid e-mail" )
+
+ else
+ Nothing
+
+
+phoneError : String -> Maybe ( ContactFormField, String )
+phoneError phone =
+ let
+ phoneRegex : Regex.Regex
+ phoneRegex =
+ Maybe.withDefault
+ Regex.never
+ (Regex.fromString "^\\+?[0-9][0-9\\s]*$")
+ in
+ if String.isEmpty phone then
+ Just ( PhoneField, "phone cannot be empty." )
+
+ else if not (Regex.contains phoneRegex phone) then
+ Just ( PhoneField, "invalid phone" )
+
+ else
+ Nothing
+
+
+view : Model -> Html.Html Msg
+view model =
+ Html.form
+ [ Attrs.class "flex flex-col gap-4 my-2 p-2.5 w-full sm:w-auto border"
+ , Attrs.class "whitespace-nowrap text-ellipsis overflow-hidden rounded"
+ , Events.onSubmit Submitted
+ ]
+ [ viewPreferredContactMethods model.isInherited model.preferredContactMethod
+ , viewEmail model.isInherited model.email model.error
+ , viewPhone model.isInherited model.phone model.error
+ , viewCompanyName model.isInherited model.companyName
+ , viewAddress model.isInherited model
+ , Html.span
+ [ Attrs.class "flex flex-row gap-4"
+ , Attrs.classList
+ [ ( "justify-end", not model.isInherited )
+ , ( "justify-center", model.isInherited )
+ ]
+ ]
+ (if model.isInherited then
+ [ Html.button
+ [ Attrs.class "w-2/6"
+ , Attrs.class "border border-black rounded px-2 py-1 text-black hover:bg-[#d2e7f9]"
+ , Attrs.type_ "button"
+ , Events.onClick Closed
+ ]
+ [ Html.text "close" ]
+ ]
+
+ else
+ [ Html.button
+ [ Attrs.class "border border-black rounded px-2 py-1 text-black hover:bg-[#d2e7f9]"
+ , Attrs.type_ "button"
+ , Events.onClick Closed
+ ]
+ [ Html.text "cancel" ]
+ , Html.button
+ [ Attrs.class "border-transparent bg-[#1e88e2] text-white outline-black hover:text-[#d2e7f9]"
+ , Attrs.class "border rounded px-2 py-1"
+ , Attrs.type_ "submit"
+ , Events.onClick Submitted
+ ]
+ [ Html.text "apply" ]
+ ]
+ )
+ ]
+
+
+viewPreferredContactMethods : Bool -> PreferredContactMethod -> Html Msg
+viewPreferredContactMethods isInherited preferredContactMethod =
+ Html.span
+ [ Attrs.class "rounded"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", isInherited ) ]
+ ]
+ [ Html.label [ Attrs.class "text-sm pl-2" ]
+ [ Html.text "Preferred contact method" ]
+ , Html.div
+ [ Attrs.class "flex gap-2 p-2"
+ , Attrs.classList [ ( "border-transparent", isInherited ) ]
+ ]
+ (allContactMethods
+ |> List.map
+ (\method ->
+ Html.button
+ [ Attrs.class "w-2/6 sm:w-1/6"
+ , Attrs.class "border rounded px-2 py-1"
+ , Attrs.classList
+ [ ( "bg-[#4ba0e8] border-transparent text-white", method == preferredContactMethod )
+ , ( "hover:bg-[#d2e7f9]", method /= preferredContactMethod && not isInherited )
+ , ( "border-transparent", isInherited )
+ ]
+ , Attrs.disabled isInherited
+ , Events.onClick (PreferredContactMethodChanged method)
+ , Attrs.type_ "button"
+ ]
+ [ Html.text (contactMethodToString method) ]
+ )
+ )
+ ]
+
+
+viewEmail : Bool -> String -> ContactFormError -> Html Msg
+viewEmail isInherited email error =
+ Input.viewTextOrNumber
+ [ Input.label "e-mail"
+ , Input.disabled isInherited
+ , Input.type_ "email"
+ , Input.onChange (Just EmailChanged)
+ , Input.value email
+ , Input.error
+ (error
+ |> Maybe.map (errorToMessage EmailField)
+ |> Maybe.withDefault ""
+ )
+ ]
+
+
+viewPhone : Bool -> String -> ContactFormError -> Html Msg
+viewPhone isInherited phone error =
+ Input.viewTextOrNumber
+ [ Input.label "phone"
+ , Input.disabled isInherited
+ , Input.type_ "tel"
+ , Input.onChange (Just PhoneChanged)
+ , Input.value phone
+ , Input.error
+ (error
+ |> Maybe.map (errorToMessage PhoneField)
+ |> Maybe.withDefault ""
+ )
+ ]
+
+
+viewCompanyName : Bool -> String -> Html Msg
+viewCompanyName isInherited companyName =
+ Input.viewTextOrNumber
+ [ Input.label "company name"
+ , Input.disabled isInherited
+ , Input.onChange (Just CompanyNameChanged)
+ , Input.value companyName
+ ]
+
+
+viewAddress : Bool -> Model -> Html Msg
+viewAddress isInherited { address, zip, city, country, error } =
+ let
+ toError : ContactFormField -> String
+ toError field =
+ error
+ |> Maybe.map (errorToMessage field)
+ |> Maybe.withDefault ""
+ in
+ Html.div
+ [ Attrs.class "flex flex-col rounded py-1"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", isInherited ) ]
+ ]
+ [ Html.span [ Attrs.class "flex flex-col sm:flex-row w-full" ]
+ [ Html.span [ Attrs.class "w-full sm:w-4/6" ]
+ [ Input.viewTextOrNumber
+ [ Input.label "address"
+ , Input.disabled isInherited
+ , Input.onChange (Just AddressChanged)
+ , Input.value address
+ , Input.error (toError AddressField)
+ ]
+ ]
+ , Html.span [ Attrs.class "w-full sm:w-2/6" ]
+ [ Input.viewTextOrNumber
+ [ Input.label "zip"
+ , Input.disabled isInherited
+ , Input.onChange (Just ZipChanged)
+ , Input.value zip
+ , Input.error (toError ZipField)
+ ]
+ ]
+ ]
+ , Html.span [ Attrs.class "flex flex-col sm:flex-row w-full sm:w-auto" ]
+ [ Html.span [ Attrs.class "w-full sm:w-3/6" ]
+ [ Input.viewTextOrNumber
+ [ Input.label "city"
+ , Input.disabled isInherited
+ , Input.onChange (Just CityChanged)
+ , Input.value city
+ , Input.error (toError CityField)
+ ]
+ ]
+ , Html.span [ Attrs.class "w-full sm:w-3/6" ]
+ [ Input.viewTextOrNumber
+ [ Input.label "country"
+ , Input.disabled isInherited
+ , Input.onChange (Just CountryChanged)
+ , Input.value country
+ , Input.error (toError CountryField)
+ ]
+ ]
+ ]
+ ]
diff --git a/src/Modules/Settings.elm b/src/Modules/Settings.elm
new file mode 100644
index 0000000..95fa938
--- /dev/null
+++ b/src/Modules/Settings.elm
@@ -0,0 +1,414 @@
+module Modules.Settings exposing
+ ( DataRetentionPolicy
+ , Model
+ , Msg
+ , Settings
+ , activePolicies
+ , decoder
+ , empty
+ , initialModel
+ , policyToString
+ , update
+ , view
+ )
+
+import Browser.Dom as Dom
+import Html exposing (Html)
+import Html.Attributes as Attrs
+import Html.Events as Events
+import Json.Decode as Decode
+import Json.Decode.Pipeline as Decode
+import Task
+
+
+type alias Model =
+ { idleDocTimeOutPreparation : Maybe Int
+ , idleDocTimeOutClosed : Maybe Int
+ , idleDocTimeOutCancelled : Maybe Int
+ , idleDocTimeOutTimedOut : Maybe Int
+ , idleDocTimeOutRejected : Maybe Int
+ , idleDocTimeOutError : Maybe Int
+ , immediateTrash : Bool
+ , isInherited : Bool
+ }
+
+
+type alias Settings =
+ { inheritedFrom : String
+ , dataRetentionPolicy : DataRetentionPolicy
+ }
+
+
+empty : Settings
+empty =
+ { inheritedFrom = ""
+ , dataRetentionPolicy = emptyDataRetentionPolicy
+ }
+
+
+decoder : Decode.Decoder Settings
+decoder =
+ Decode.succeed Settings
+ |> Decode.optional "inherited_from" Decode.string ""
+ |> Decode.required "data_retention_policy" dataRetentionPolicyDecoder
+
+
+type alias DataRetentionPolicy =
+ { idleDocTimeOutPreparation : Maybe Int
+ , idleDocTimeOutClosed : Maybe Int
+ , idleDocTimeOutCancelled : Maybe Int
+ , idleDocTimeOutTimedOut : Maybe Int
+ , idleDocTimeOutRejected : Maybe Int
+ , idleDocTimeOutError : Maybe Int
+ , immediateTrash : Bool
+ }
+
+
+emptyDataRetentionPolicy : DataRetentionPolicy
+emptyDataRetentionPolicy =
+ { idleDocTimeOutPreparation = Nothing
+ , idleDocTimeOutClosed = Nothing
+ , idleDocTimeOutCancelled = Nothing
+ , idleDocTimeOutTimedOut = Nothing
+ , idleDocTimeOutRejected = Nothing
+ , idleDocTimeOutError = Nothing
+ , immediateTrash = False
+ }
+
+
+dataRetentionPolicyDecoder : Decode.Decoder DataRetentionPolicy
+dataRetentionPolicyDecoder =
+ Decode.succeed DataRetentionPolicy
+ |> Decode.optional "idle_doc_timeout_preparation" (Decode.map Just Decode.int) Nothing
+ |> Decode.optional "idle_doc_timeout_closed" (Decode.map Just Decode.int) Nothing
+ |> Decode.optional "idle_doc_timeout_canceled" (Decode.map Just Decode.int) Nothing
+ |> Decode.optional "idle_doc_timeout_timedout" (Decode.map Just Decode.int) Nothing
+ |> Decode.optional "idle_doc_timeout_rejected" (Decode.map Just Decode.int) Nothing
+ |> Decode.optional "idle_doc_timeout_error" (Decode.map Just Decode.int) Nothing
+ |> Decode.required "immediate_trash" Decode.bool
+
+
+activePolicies :
+ { a
+ | idleDocTimeOutPreparation : Maybe Int
+ , idleDocTimeOutClosed : Maybe Int
+ , idleDocTimeOutCancelled : Maybe Int
+ , idleDocTimeOutTimedOut : Maybe Int
+ , idleDocTimeOutRejected : Maybe Int
+ , idleDocTimeOutError : Maybe Int
+ }
+ -> List ( Policy, Int )
+activePolicies policies =
+ [ policies.idleDocTimeOutPreparation |> Maybe.map (\value -> ( Preparation, value ))
+ , policies.idleDocTimeOutClosed |> Maybe.map (\value -> ( Closed, value ))
+ , policies.idleDocTimeOutCancelled |> Maybe.map (\value -> ( Cancelled, value ))
+ , policies.idleDocTimeOutTimedOut |> Maybe.map (\value -> ( TimedOut, value ))
+ , policies.idleDocTimeOutRejected |> Maybe.map (\value -> ( Rejected, value ))
+ , policies.idleDocTimeOutError |> Maybe.map (\value -> ( Error, value ))
+ ]
+ |> List.filterMap identity
+
+
+type Policy
+ = Preparation
+ | Closed
+ | Cancelled
+ | TimedOut
+ | Rejected
+ | Error
+
+
+policyToString : Policy -> String
+policyToString policy =
+ case policy of
+ Preparation ->
+ "preparation"
+
+ Closed ->
+ "closed"
+
+ Cancelled ->
+ "cancelled"
+
+ TimedOut ->
+ "timedOut"
+
+ Rejected ->
+ "rejected"
+
+ Error ->
+ "error"
+
+
+inactivePolicies :
+ { a
+ | idleDocTimeOutPreparation : Maybe Int
+ , idleDocTimeOutClosed : Maybe Int
+ , idleDocTimeOutCancelled : Maybe Int
+ , idleDocTimeOutTimedOut : Maybe Int
+ , idleDocTimeOutRejected : Maybe Int
+ , idleDocTimeOutError : Maybe Int
+ }
+ -> List Policy
+inactivePolicies policies =
+ [ ( policies.idleDocTimeOutPreparation, Preparation )
+ , ( policies.idleDocTimeOutClosed, Closed )
+ , ( policies.idleDocTimeOutCancelled, Cancelled )
+ , ( policies.idleDocTimeOutTimedOut, TimedOut )
+ , ( policies.idleDocTimeOutRejected, Rejected )
+ , ( policies.idleDocTimeOutError, Error )
+ ]
+ |> List.filter (Tuple.first >> (==) Nothing)
+ |> List.map Tuple.second
+
+
+initialModel :
+ { idleDocTimeOutPreparation : Maybe Int
+ , idleDocTimeOutClosed : Maybe Int
+ , idleDocTimeOutCancelled : Maybe Int
+ , idleDocTimeOutTimedOut : Maybe Int
+ , idleDocTimeOutRejected : Maybe Int
+ , idleDocTimeOutError : Maybe Int
+ , immediateTrash : Bool
+ }
+ -> { isInherited : Bool }
+ -> Model
+initialModel dataRetentionPolicy { isInherited } =
+ { idleDocTimeOutPreparation = dataRetentionPolicy.idleDocTimeOutPreparation
+ , idleDocTimeOutClosed = dataRetentionPolicy.idleDocTimeOutClosed
+ , idleDocTimeOutCancelled = dataRetentionPolicy.idleDocTimeOutCancelled
+ , idleDocTimeOutTimedOut = dataRetentionPolicy.idleDocTimeOutTimedOut
+ , idleDocTimeOutRejected = dataRetentionPolicy.idleDocTimeOutRejected
+ , idleDocTimeOutError = dataRetentionPolicy.idleDocTimeOutError
+ , immediateTrash = dataRetentionPolicy.immediateTrash
+ , isInherited = isInherited
+ }
+
+
+type Msg
+ = Submitted
+ | FormClosed
+ | AddPolicy Policy
+ | PolicyChanged Policy String
+ | ImmediateTrashChecked Bool
+ | Removed Policy
+
+
+update : Msg -> Model -> { onSubmit : Model -> msg, onClose : msg, onFocus : msg } -> ( Model, Cmd msg )
+update msg model config =
+ case msg of
+ Submitted ->
+ let
+ newModel : Model
+ newModel =
+ { model
+ | idleDocTimeOutPreparation = nonZero model.idleDocTimeOutPreparation
+ , idleDocTimeOutClosed = nonZero model.idleDocTimeOutClosed
+ , idleDocTimeOutCancelled = nonZero model.idleDocTimeOutCancelled
+ , idleDocTimeOutTimedOut = nonZero model.idleDocTimeOutTimedOut
+ , idleDocTimeOutRejected = nonZero model.idleDocTimeOutRejected
+ , idleDocTimeOutError = nonZero model.idleDocTimeOutError
+ }
+ in
+ ( newModel
+ , Task.perform config.onSubmit (Task.succeed newModel)
+ )
+
+ FormClosed ->
+ ( model
+ , Task.perform (\_ -> config.onClose) (Task.succeed "")
+ )
+
+ AddPolicy policy ->
+ ( changePolicy policy (Just 0) model
+ , Task.attempt (\_ -> config.onFocus) (Dom.focus (policyToString policy ++ "-input"))
+ )
+
+ PolicyChanged policy value ->
+ ( changePolicy policy (String.toFloat value |> Maybe.map Basics.round) model
+ , Cmd.none
+ )
+
+ ImmediateTrashChecked bool ->
+ ( { model | immediateTrash = bool }
+ , Cmd.none
+ )
+
+ Removed policy ->
+ ( changePolicy policy Nothing model
+ , Cmd.none
+ )
+
+
+nonZero : Maybe Int -> Maybe Int
+nonZero maybeInt =
+ case maybeInt of
+ Just 0 ->
+ Nothing
+
+ _ ->
+ maybeInt
+
+
+changePolicy : Policy -> Maybe Int -> Model -> Model
+changePolicy policy value model =
+ case policy of
+ Preparation ->
+ { model | idleDocTimeOutPreparation = value }
+
+ Closed ->
+ { model | idleDocTimeOutClosed = value }
+
+ Cancelled ->
+ { model | idleDocTimeOutCancelled = value }
+
+ TimedOut ->
+ { model | idleDocTimeOutTimedOut = value }
+
+ Rejected ->
+ { model | idleDocTimeOutRejected = value }
+
+ Error ->
+ { model | idleDocTimeOutError = value }
+
+
+view : Model -> Html Msg
+view ({ isInherited } as model) =
+ Html.form
+ [ Attrs.class "flex flex-col gap-4 my-2 p-2.5 w-full"
+ , Attrs.class "sm:w-6/12 md:w-3/6 lg:w-2/6 border rounded"
+ , Attrs.class "whitespace-nowrap text-ellipsis overflow-hidden"
+ , Events.onSubmit Submitted
+ ]
+ ([ [ Html.h1 [ Attrs.class "text-md font-semibold text-stone-700 pl-1", Attrs.class "border-b" ]
+ [ Html.text "Data retention policy" ]
+ ]
+ , activePolicies model
+ |> List.map (viewActivePolicy isInherited)
+ , [ Html.span
+ [ Attrs.class "flex flex-row rounded p-2.5 justify-between"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", isInherited ) ]
+ ]
+ [ Html.label [ Attrs.class "text-md font-semibold text-stone-700 pl-1" ]
+ [ Html.text "immediate trash" ]
+ , Html.input
+ [ Attrs.type_ "checkbox"
+ , Attrs.class "border-stone-400 w-4"
+ , Attrs.class "border rounded px-2 py-1"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", isInherited ) ]
+ , Attrs.disabled isInherited
+ , Events.onCheck ImmediateTrashChecked
+ , Attrs.checked model.immediateTrash
+ ]
+ []
+ ]
+ ]
+ , if not isInherited then
+ inactivePolicies model
+ |> List.map (viewInactivePolicy isInherited)
+
+ else
+ []
+ , [ viewSubmitSection isInherited ]
+ ]
+ |> List.concat
+ )
+
+
+viewActivePolicy : Bool -> ( Policy, Int ) -> Html Msg
+viewActivePolicy isInherited ( policy, value ) =
+ Html.span
+ [ Attrs.class "flex flex-row rounded p-2.5 justify-between items-center"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", isInherited ) ]
+ ]
+ [ Html.label [ Attrs.class "text-md font-semibold text-stone-700 pl-1" ]
+ [ Html.text (policyToString policy ++ ":") ]
+ , Html.div []
+ ([ Html.input
+ [ Attrs.type_ "number"
+ , Attrs.id (policyToString policy ++ "-input")
+ , Attrs.class "focus:outline-none border-stone-400 w-24 text-md"
+ , Attrs.class "text-right text-normal text-stone-700 appearance-none"
+ , Attrs.class "[appearance:textfield] [&::-webkit-outer-spin-button]:appearance-none"
+ , Attrs.class "[&::-webkit-inner-spin-button]:appearance-none"
+ , Attrs.class "border rounded px-2 py-1"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", isInherited ) ]
+ , Attrs.disabled isInherited
+ , Attrs.value (String.fromInt value)
+ , Events.onInput (PolicyChanged policy)
+ ]
+ []
+ ]
+ ++ (if isInherited then
+ []
+
+ else
+ [ Html.button
+ [ Attrs.class "border border-transparent rounded px-2 py-1 my-1 bg-red-400"
+ , Attrs.class "text-white outline-black hover:text-[#d2e7f9] w-12 ml-1"
+ , Attrs.type_ "button"
+ , Events.onClick (Removed policy)
+ ]
+ [ Html.text "x" ]
+ ]
+ )
+ )
+ ]
+
+
+viewInactivePolicy : Bool -> Policy -> Html Msg
+viewInactivePolicy isInherited policy =
+ Html.span
+ [ Attrs.class "flex flex-row rounded p-2.5 justify-between items-center bg-stone-100"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", isInherited ) ]
+ ]
+ [ Html.label [ Attrs.class "text-md font-semibold text-stone-700 pl-1" ]
+ [ Html.text (policyToString policy ++ ":") ]
+ , Html.button
+ [ Attrs.type_ "button"
+ , Attrs.class "hover:bg-[#d2e7f9] border-stone-400 text-md"
+ , Attrs.class "text-right text-normal text-stone-700"
+ , Attrs.class "border rounded px-2 py-1"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", isInherited ) ]
+ , Attrs.disabled isInherited
+ , Events.onClick (AddPolicy policy)
+ ]
+ [ Html.text "add" ]
+ ]
+
+
+viewSubmitSection : Bool -> Html Msg
+viewSubmitSection isInherited =
+ Html.span
+ [ Attrs.class "flex flex-row gap-4"
+ , Attrs.classList
+ [ ( "justify-end", not isInherited )
+ , ( "justify-center", isInherited )
+ ]
+ ]
+ (if isInherited then
+ [ Html.button
+ [ Attrs.class "w-2/6"
+ , Attrs.class "border border-black rounded px-2 py-1 text-black hover:bg-[#d2e7f9]"
+ , Attrs.type_ "button"
+ , Events.onClick FormClosed
+ ]
+ [ Html.text "close" ]
+ ]
+
+ else
+ [ Html.button
+ [ Attrs.class "border border-black rounded px-2 py-1 text-black hover:bg-[#d2e7f9]"
+ , Attrs.type_ "button"
+ , Events.onClick FormClosed
+ ]
+ [ Html.text "cancel" ]
+ , Html.button
+ [ Attrs.class "border border-transparent rounded px-2 py-1 bg-[#1e88e2]"
+ , Attrs.class "text-white outline-black hover:text-[#d2e7f9]"
+ , Attrs.type_ "submit"
+ , Events.onClick Submitted
+ ]
+ [ Html.text "apply" ]
+ ]
+ )
diff --git a/src/Modules/Tags.elm b/src/Modules/Tags.elm
new file mode 100644
index 0000000..455df4d
--- /dev/null
+++ b/src/Modules/Tags.elm
@@ -0,0 +1,337 @@
+module Modules.Tags exposing
+ ( Model
+ , Msg
+ , decoder
+ , initialModel
+ , update
+ , view
+ )
+
+import Browser.Dom as Dom
+import Components.Input as Input
+import Dict exposing (Dict)
+import Html exposing (Html)
+import Html.Attributes as Attrs
+import Html.Events as Events
+import Json.Decode as Decode
+import Json.Decode.Pipeline as Decode
+import Task
+
+
+type alias Model =
+ { tags : Dict Int Tag
+ , newTagName : String
+ , newTagValue : String
+ , isInherited : Bool
+ , newTagError : String
+ , tagsErrors : Dict Int String
+ }
+
+
+type alias Tag =
+ { name : String
+ , value : String
+ }
+
+
+decoder : Decode.Decoder Tag
+decoder =
+ Decode.succeed Tag
+ |> Decode.required "name" Decode.string
+ |> Decode.optional "value" Decode.string ""
+
+
+initialModel : { tags : Dict String String, isInherited : Bool } -> Model
+initialModel { tags, isInherited } =
+ { tags =
+ tags
+ |> Dict.toList
+ |> List.indexedMap
+ (\index value ->
+ ( index
+ , { name = Tuple.first value
+ , value = Tuple.second value
+ }
+ )
+ )
+ |> Dict.fromList
+ , newTagName = ""
+ , newTagValue = ""
+ , isInherited = isInherited
+ , newTagError = ""
+ , tagsErrors = Dict.empty
+ }
+
+
+type Msg
+ = NoOp
+ | NameChanged Int { name : String }
+ | ValueChanged Int { value : String }
+ | Removed Int
+ | TagAdded
+ | NewTagNameChanged String
+ | NewTagValueChanged String
+ | TagsValidated
+ | Submitted
+ | Closed
+
+
+update : Msg -> Model -> { onSubmit : Model -> msg, onClose : msg, onFocus : msg } -> ( Model, Cmd msg )
+update msg model config =
+ case msg of
+ NoOp ->
+ ( model, Cmd.none )
+
+ NameChanged key { name } ->
+ ( { model
+ | tags =
+ Dict.update
+ key
+ (Maybe.map (\a -> { name = name, value = a.value }))
+ model.tags
+ }
+ , Cmd.none
+ )
+
+ ValueChanged key { value } ->
+ ( { model
+ | tags =
+ Dict.update
+ key
+ (Maybe.map (\a -> { name = a.name, value = value }))
+ model.tags
+ }
+ , Cmd.none
+ )
+
+ Removed key ->
+ ( { model
+ | tags = Dict.remove key model.tags
+ , tagsErrors = Dict.remove key model.tagsErrors
+ }
+ , Cmd.none
+ )
+
+ TagAdded ->
+ ( checkTag model.tags
+ { name = model.newTagName
+ , value = model.newTagValue
+ }
+ |> Maybe.map
+ (\error ->
+ { model | newTagError = error }
+ )
+ |> Maybe.withDefault
+ { model
+ | tags =
+ Dict.toList model.tags
+ |> List.map Tuple.second
+ |> (\newTags ->
+ newTags
+ ++ [ { name = model.newTagName, value = model.newTagValue } ]
+ )
+ |> List.indexedMap (\index value -> ( index, value ))
+ |> Dict.fromList
+ , newTagName = ""
+ , newTagValue = ""
+ , newTagError = ""
+ }
+ , Task.attempt (\_ -> config.onFocus) (Dom.focus "new-tag-input")
+ )
+
+ NewTagNameChanged newTagName ->
+ ( { model | newTagName = newTagName }, Cmd.none )
+
+ NewTagValueChanged newTagValue ->
+ ( { model | newTagValue = newTagValue }, Cmd.none )
+
+ TagsValidated ->
+ let
+ tagsErrors : Dict Int String
+ tagsErrors =
+ Dict.foldl
+ (\k _ acc ->
+ Dict.get k model.tags
+ |> Maybe.andThen (checkTag (Dict.remove k model.tags))
+ |> Maybe.map (\err -> Dict.insert k err acc)
+ |> Maybe.withDefault acc
+ )
+ Dict.empty
+ model.tags
+ in
+ ( { model | tagsErrors = tagsErrors }
+ , Cmd.none
+ )
+
+ Submitted ->
+ ( model
+ , Task.perform config.onSubmit (Task.succeed model)
+ )
+
+ Closed ->
+ ( model
+ , Task.perform (\_ -> config.onClose) (Task.succeed "")
+ )
+
+
+checkTag : Dict Int Tag -> Tag -> Maybe String
+checkTag tags tag =
+ if String.isEmpty tag.name then
+ Just "empty"
+
+ else if String.length tag.name > 32 then
+ Just "too long (32)"
+
+ else if
+ Dict.values tags
+ |> List.map .name
+ |> List.any ((==) tag.name)
+ then
+ Just "exists"
+
+ else
+ Nothing
+
+
+view : Model -> Html Msg
+view model =
+ Html.div
+ [ Attrs.class "w-full sm:w-auto flex flex-col gap-1"
+ , Attrs.class "justify-center border rounded p-2.5 my-2"
+ ]
+ ([ Html.h1
+ [ Attrs.class "text-lg text-center font-semibold text-stone-800" ]
+ [ Html.text "Tags:" ]
+ ]
+ ++ (if Dict.isEmpty model.tags then
+ [ Html.p
+ [ Attrs.class "text-center" ]
+ [ Html.text "no tags for now" ]
+ ]
+
+ else
+ model.tags
+ |> Dict.toList
+ |> List.map (viewTag model)
+ )
+ ++ (if model.isInherited then
+ []
+
+ else
+ [ viewAddTag model ]
+ )
+ ++ [ viewFormSubmitSection model ]
+ )
+
+
+viewFormSubmitSection : Model -> Html Msg
+viewFormSubmitSection model =
+ Html.span
+ [ Attrs.class "flex flex-row gap-4 my-2"
+ , Attrs.classList
+ [ ( "justify-end", not model.isInherited )
+ , ( "justify-center", model.isInherited )
+ ]
+ ]
+ (if model.isInherited then
+ [ Html.button
+ [ Attrs.class "w-2/6"
+ , Attrs.class "border border-black rounded px-2 py-1 text-black hover:bg-[#d2e7f9]"
+ , Attrs.type_ "button"
+ , Events.onClick Closed
+ ]
+ [ Html.text "close" ]
+ ]
+
+ else
+ [ Html.button
+ [ Attrs.class "border border-black rounded px-2 py-1 text-black hover:bg-[#d2e7f9]"
+ , Attrs.type_ "button"
+ , Events.onClick Closed
+ ]
+ [ Html.text "cancel" ]
+ , Html.button
+ [ Attrs.class "border border-transparent rounded px-2 py-1 bg-[#1e88e2]"
+ , Attrs.class "text-white outline-black hover:text-[#d2e7f9]"
+ , Attrs.classList
+ [ ( "bg-[#1e88e2]", Dict.isEmpty model.tagsErrors )
+ , ( "bg-red-200", not (Dict.isEmpty model.tagsErrors) )
+ ]
+ , Attrs.type_ "submit"
+ , Attrs.disabled (not (Dict.isEmpty model.tagsErrors))
+ , Events.onClick Submitted
+ ]
+ [ Html.text "apply" ]
+ ]
+ )
+
+
+viewAddTag : Model -> Html Msg
+viewAddTag model =
+ Html.form
+ [ Attrs.class "flex flex-row py-1 px-2 mt-2 justify-between items-end border-b"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", model.isInherited ) ]
+ , Events.onSubmit TagAdded
+ ]
+ [ Input.viewTextOrNumber
+ [ Input.label "new tag:"
+ , Input.id "new-tag-input"
+ , Input.disabled model.isInherited
+ , Input.type_ "text"
+ , Input.onChange (Just NewTagNameChanged)
+ , Input.error model.newTagError
+ , Input.value model.newTagName
+ ]
+ , Input.viewTextOrNumber
+ [ Input.label "value:"
+ , Input.id "new-tag-value-input"
+ , Input.disabled model.isInherited
+ , Input.onChange (Just NewTagValueChanged)
+ , Input.value model.newTagValue
+ ]
+ , Html.input [ Attrs.type_ "submit", Attrs.class "hidden" ]
+ []
+ , Html.button
+ [ Attrs.class "my-1 bg-green-200"
+ , Attrs.class "border border-black rounded px-2 py-1 text-black hover:bg-[#d2e7f9]"
+ , Attrs.type_ "button"
+ , Events.onClick TagAdded
+ ]
+ [ Html.text "add" ]
+ ]
+
+
+viewTag : Model -> ( Int, { name : String, value : String } ) -> Html Msg
+viewTag model ( key, value ) =
+ Html.span
+ [ Attrs.class "flex flex-row px-2 justify-between border-b items-end rounded"
+ , Attrs.classList [ ( "bg-[#e8f3fc]", model.isInherited ) ]
+ ]
+ ([ Input.viewTextOrNumber
+ [ Input.disabled model.isInherited
+ , Input.onChange (Just (\newName -> NameChanged key { name = newName }))
+ , Input.value value.name
+ , Input.label "name:"
+ , Input.onBlur (Just TagsValidated)
+ , Input.error (Dict.get key model.tagsErrors |> Maybe.withDefault "")
+ ]
+ , Input.viewTextOrNumber
+ [ Input.disabled model.isInherited
+ , Input.onChange (Just (\newValue -> ValueChanged key { value = newValue }))
+ , Input.value value.value
+ , Input.label "value:"
+ ]
+ ]
+ ++ (if not model.isInherited then
+ [ Html.button
+ [ Attrs.class "border border-transparent rounded px-2 py-1 my-1 bg-red-400"
+ , Attrs.class "text-white outline-black hover:text-[#d2e7f9] w-12"
+ , Events.onClick (Removed key)
+ ]
+ [ Html.text "x" ]
+ ]
+
+ else
+ []
+ )
+ )
diff --git a/tailwind.config.js b/tailwind.config.js
index 5c23f75..5e1a361 100644
--- a/tailwind.config.js
+++ b/tailwind.config.js
@@ -1,13 +1,17 @@
/** @type {import('tailwindcss').Config} */
export default {
- content: [
- "./src/**/*.{elm, js}",
- "./index.html"
- ],
- theme: {
- extend: {},
- },
- plugins: [ ],
+ content: [
+ "./src/**/*.{elm, js}",
+ "./index.html"
+ ],
+ theme: {
+ extend: {
+ fontFamily: {
+ montserrat: ['Montserrat', 'sans-serif'],
+ },
+ },
+ },
+ plugins: [],
}