diff options
Diffstat (limited to 'client/src')
| -rw-r--r-- | client/src/Admin.elm | 20 | ||||
| -rw-r--r-- | client/src/Common.elm | 27 | ||||
| -rw-r--r-- | client/src/Login.elm | 30 | ||||
| -rw-r--r-- | client/src/Manager.elm | 11 | ||||
| -rw-r--r-- | client/src/State.elm | 242 | ||||
| -rw-r--r-- | client/src/UI.elm | 25 | ||||
| -rw-r--r-- | client/src/User.elm | 113 |
7 files changed, 373 insertions, 95 deletions
diff --git a/client/src/Admin.elm b/client/src/Admin.elm index 3c0f221d93ed..e8e33bde617b 100644 --- a/client/src/Admin.elm +++ b/client/src/Admin.elm @@ -5,6 +5,7 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import RemoteData import State +import Common import Tailwind import UI import Utils @@ -78,22 +79,5 @@ render model = , case model.adminTab of State.Users -> allUsers model - , case model.logoutError of - Nothing -> - text "" - - Just e -> - UI.errorBanner - { title = "Error logging out" - , body = Utils.explainHttpError e - } - , case model.deleteUserError of - Nothing -> - text "" - - Just e -> - UI.errorBanner - { title = "Error attempting to delete user" - , body = Utils.explainHttpError e - } + , Common.allErrors model ] diff --git a/client/src/Common.elm b/client/src/Common.elm new file mode 100644 index 000000000000..a3106114d43a --- /dev/null +++ b/client/src/Common.elm @@ -0,0 +1,27 @@ +module Common exposing (..) + +import Html exposing (..) +import Maybe.Extra as ME +import State +import UI +import Utils + + +allErrors : State.Model -> Html State.Msg +allErrors model = + div [] + (State.allErrors + model + |> List.map + (\( mError, title ) -> + case mError of + Nothing -> + text "" + + Just err -> + UI.errorBanner + { title = title + , body = Utils.explainHttpError err + } + ) + ) diff --git a/client/src/Login.elm b/client/src/Login.elm index 60a45e7fca77..083c4705609d 100644 --- a/client/src/Login.elm +++ b/client/src/Login.elm @@ -1,5 +1,6 @@ module Login exposing (render) +import Common import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) @@ -137,24 +138,7 @@ login model = ] [ UI.header 3 "Welcome to Trip Planner" , loginForm model - , case model.loginError of - Nothing -> - text "" - - Just e -> - UI.errorBanner - { title = "Error logging in" - , body = Utils.explainHttpError e - } - , case model.signUpError of - Nothing -> - text "" - - Just e -> - UI.errorBanner - { title = "Error creating account" - , body = Utils.explainHttpError e - } + , Common.allErrors model ] @@ -174,15 +158,7 @@ logout model = { label = "Logout" , handleClick = State.AttemptLogout } - , case model.logoutError of - Nothing -> - text "" - - Just e -> - UI.errorBanner - { title = "Error logging out" - , body = Utils.explainHttpError e - } + , Common.allErrors model ] diff --git a/client/src/Manager.elm b/client/src/Manager.elm index b7f36cfd46bb..7cf5dc3107c3 100644 --- a/client/src/Manager.elm +++ b/client/src/Manager.elm @@ -1,6 +1,7 @@ module Manager exposing (render) import Array +import Common import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) @@ -33,14 +34,6 @@ render model = { label = "Logout" , handleClick = State.AttemptLogout } - , case model.logoutError of - Nothing -> - text "" - - Just e -> - UI.errorBanner - { title = "Error logging out" - , body = Utils.explainHttpError e - } + , Common.allErrors model ] ] diff --git a/client/src/State.elm b/client/src/State.elm index e23580a05ebb..66b3e57f0c79 100644 --- a/client/src/State.elm +++ b/client/src/State.elm @@ -3,6 +3,8 @@ module State exposing (..) import Array exposing (Array) import Browser import Browser.Navigation as Nav +import Date +import DatePicker import Http import Json.Decode as JD import Json.Decode.Extra as JDE @@ -31,6 +33,10 @@ type Msg | UpdatePassword String | UpdateRole String | UpdateAdminTab AdminTab + | UpdateTripDestination String + | UpdateTripStartDate DatePicker.Msg + | UpdateTripEndDate DatePicker.Msg + | UpdateTripComment String | ClearErrors | ToggleLoginForm -- SPA @@ -42,12 +48,15 @@ type Msg | AttemptLogin | AttemptLogout | AttemptDeleteUser String + | AttemptCreateTrip Date.Date Date.Date -- Inbound network | GotUsers (WebData AllUsers) + | GotTrips (WebData (List Trip)) | GotSignUp (Result Http.Error Session) | GotLogin (Result Http.Error Session) | GotLogout (Result Http.Error String) | GotDeleteUser (Result Http.Error String) + | CreatedTrip (Result Http.Error ()) type Route @@ -85,13 +94,6 @@ type alias Review = } -type alias Reviews = - { hi : Maybe Review - , lo : Maybe Review - , all : List Review - } - - type AdminTab = Users @@ -101,6 +103,14 @@ type LoginTab | SignUpForm +type alias Trip = + { destination : String + , startDate : Date.Date + , endDate : Date.Date + , comment : String + } + + type alias Model = { route : Maybe Route , url : Url.Url @@ -111,15 +121,33 @@ type alias Model = , password : String , role : Maybe Role , users : WebData AllUsers + , startDatePicker : DatePicker.DatePicker + , endDatePicker : DatePicker.DatePicker + , tripDestination : String + , tripStartDate : Maybe Date.Date + , tripEndDate : Maybe Date.Date + , tripComment : String + , trips : WebData (List Trip) , adminTab : AdminTab , loginTab : LoginTab , loginError : Maybe Http.Error , logoutError : Maybe Http.Error , signUpError : Maybe Http.Error , deleteUserError : Maybe Http.Error + , createTripError : Maybe Http.Error } +allErrors : Model -> List ( Maybe Http.Error, String ) +allErrors model = + [ ( model.loginError, "Error attempting to authenticate" ) + , ( model.logoutError, "Error attempting to log out" ) + , ( model.signUpError, "Error attempting to create your account" ) + , ( model.deleteUserError, "Error attempting to delete a user" ) + , ( model.createTripError, "Error attempting to create a trip" ) + ] + + -------------------------------------------------------------------------------- -- Functions @@ -220,6 +248,31 @@ signUp { username, email, password } = } +createTrip : + { username : String + , destination : String + , startDate : Date.Date + , endDate : Date.Date + , comment : String + } + -> Cmd Msg +createTrip { username, destination, startDate, endDate, comment } = + Utils.postWithCredentials + { url = endpoint [ "trips" ] [] + , body = + Http.jsonBody + (JE.object + [ ( "username", JE.string username ) + , ( "destination", JE.string destination ) + , ( "startDate", encodeDate startDate ) + , ( "endDate", encodeDate endDate ) + , ( "comment", JE.string comment ) + ] + ) + , expect = Http.expectWhatever CreatedTrip + } + + deleteUser : String -> Cmd Msg deleteUser username = Utils.deleteWithCredentials @@ -239,6 +292,35 @@ decodeReview = (JD.field "timestamp" JD.string) +encodeDate : Date.Date -> JE.Value +encodeDate date = + date |> Date.toIsoString |> JE.string + + +decodeDate : JD.Decoder Date.Date +decodeDate = + JD.string |> JD.andThen (Date.fromIsoString >> JDE.fromResult) + + +fetchTrips : Cmd Msg +fetchTrips = + Utils.getWithCredentials + { url = endpoint [ "trips" ] [] + , expect = + Http.expectJson + (RemoteData.fromResult >> GotTrips) + (JD.list + (JD.map4 + Trip + (JD.field "destination" JD.string) + (JD.field "startDate" decodeDate) + (JD.field "endDate" decodeDate) + (JD.field "comment" JD.string) + ) + ) + } + + fetchUsers : Cmd Msg fetchUsers = Utils.getWithCredentials @@ -301,6 +383,13 @@ routeParser = -} init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) init _ url key = + let + ( startDatePicker, startDatePickerCmd ) = + DatePicker.init + + ( endDatePicker, endDatePickerCmd ) = + DatePicker.init + in ( { route = Nothing , url = url , key = key @@ -310,14 +399,25 @@ init _ url key = , password = "" , role = Nothing , users = RemoteData.NotAsked + , tripDestination = "" + , tripStartDate = Nothing + , tripEndDate = Nothing + , tripComment = "" + , trips = RemoteData.NotAsked + , startDatePicker = startDatePicker + , endDatePicker = endDatePicker , adminTab = Users , loginTab = LoginForm , loginError = Nothing , logoutError = Nothing , signUpError = Nothing , deleteUserError = Nothing + , createTripError = Nothing } - , Cmd.none + , Cmd.batch + [ Cmd.map UpdateTripStartDate startDatePickerCmd + , Cmd.map UpdateTripEndDate endDatePickerCmd + ] ) @@ -359,12 +459,59 @@ update msg model = in ( { model | role = maybeRole }, Cmd.none ) + UpdateTripDestination x -> + ( { model | tripDestination = x }, Cmd.none ) + + UpdateTripStartDate dpMsg -> + let + ( newDatePicker, dateEvent ) = + DatePicker.update DatePicker.defaultSettings dpMsg model.startDatePicker + + newDate = + case dateEvent of + DatePicker.Picked changedDate -> + Just changedDate + + _ -> + model.tripStartDate + in + ( { model + | tripStartDate = newDate + , startDatePicker = newDatePicker + } + , Cmd.none + ) + + UpdateTripEndDate dpMsg -> + let + ( newDatePicker, dateEvent ) = + DatePicker.update DatePicker.defaultSettings dpMsg model.endDatePicker + + newDate = + case dateEvent of + DatePicker.Picked changedDate -> + Just changedDate + + _ -> + model.tripEndDate + in + ( { model + | tripEndDate = newDate + , endDatePicker = newDatePicker + } + , Cmd.none + ) + + UpdateTripComment x -> + ( { model | tripComment = x }, Cmd.none ) + ClearErrors -> ( { model | loginError = Nothing , logoutError = Nothing , signUpError = Nothing , deleteUserError = Nothing + , createTripError = Nothing } , Cmd.none ) @@ -400,27 +547,18 @@ update msg model = ( { model | url = url , route = route + , trips = RemoteData.Loading } - , Cmd.none + , fetchTrips ) Just ManagerHome -> - case model.session of - Nothing -> - ( { model - | url = url - , route = route - } - , Cmd.none - ) - - Just session -> - ( { model - | url = url - , route = route - } - , Cmd.none - ) + ( { model + | url = url + , route = route + } + , Cmd.none + ) Just AdminHome -> ( { model @@ -439,14 +577,14 @@ update msg model = , Cmd.none ) - -- GET /all-usernames + -- GET /accounts AttemptGetUsers -> ( { model | users = RemoteData.Loading }, fetchUsers ) GotUsers xs -> ( { model | users = xs }, Cmd.none ) - -- DELETE /user/:username + -- DELETE /accounts AttemptDeleteUser username -> ( model, deleteUser username ) @@ -460,7 +598,47 @@ update msg model = , sleepAndClearErrors ) - -- /create-account + -- POST /trips + AttemptCreateTrip startDate endDate -> + ( model + , case model.session of + Nothing -> + Cmd.none + + Just session -> + createTrip + { username = session.username + , destination = model.tripDestination + , startDate = startDate + , endDate = endDate + , comment = model.tripComment + } + ) + + CreatedTrip result -> + case result of + Ok _ -> + ( { model + | tripDestination = "" + , tripStartDate = Nothing + , tripEndDate = Nothing + , tripComment = "" + } + , fetchTrips + ) + + Err e -> + ( { model + | createTripError = Just e + , tripDestination = "" + , tripStartDate = Nothing + , tripEndDate = Nothing + , tripComment = "" + } + , sleepAndClearErrors + ) + + -- POST /accounts AttemptSignUp -> ( model , signUp @@ -482,7 +660,11 @@ update msg model = , sleepAndClearErrors ) - -- /login + -- GET /trips + GotTrips xs -> + ( { model | trips = xs }, Cmd.none ) + + -- POST /login AttemptLogin -> ( model, login model.username model.password ) @@ -498,7 +680,7 @@ update msg model = , sleepAndClearErrors ) - -- / logout + -- GET /logout AttemptLogout -> ( model, logout ) diff --git a/client/src/UI.elm b/client/src/UI.elm index 482c6ebe9dd8..1de137fcaf4f 100644 --- a/client/src/UI.elm +++ b/client/src/UI.elm @@ -1,5 +1,7 @@ module UI exposing (..) +import Date +import DatePicker exposing (defaultSettings) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) @@ -284,3 +286,26 @@ absentData { handleFetch } = } ] ] + + +datePicker : + { mDate : Maybe Date.Date + , prompt : String + , prefix : String + , picker : DatePicker.DatePicker + , onUpdate : DatePicker.Msg -> State.Msg + } + -> Html State.Msg +datePicker { mDate, prompt, prefix, picker, onUpdate } = + let + settings = + { defaultSettings + | placeholder = prompt + , inputClassList = + [ ( "text-center", True ) + , ( "py-2", True ) + ] + } + in + div [ [ "w-1/2", "py-4", "mx-auto" ] |> Tailwind.use |> class ] + [ DatePicker.view mDate settings picker |> Html.map onUpdate ] diff --git a/client/src/User.elm b/client/src/User.elm index 7139d2028368..5216eeada03e 100644 --- a/client/src/User.elm +++ b/client/src/User.elm @@ -1,9 +1,12 @@ module User exposing (render) +import Common +import Date +import DatePicker import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Maybe.Extra +import Maybe.Extra as ME import RemoteData import State import Tailwind @@ -11,6 +14,100 @@ import UI import Utils +createTrip : State.Model -> Html State.Msg +createTrip model = + div [] + [ UI.header 3 "Plan Upcoming Trip" + , UI.textField + { pholder = "Where are you going?" + , inputId = "destination" + , handleInput = State.UpdateTripDestination + , inputValue = model.tripDestination + } + , div [ [ "flex" ] |> Tailwind.use |> class ] + [ UI.datePicker + { mDate = model.tripStartDate + , prompt = "Set departure date" + , prefix = "Departure: " + , picker = model.startDatePicker + , onUpdate = State.UpdateTripStartDate + } + , UI.datePicker + { mDate = model.tripEndDate + , prompt = "Set return date" + , prefix = "Return: " + , picker = model.endDatePicker + , onUpdate = State.UpdateTripEndDate + } + ] + , UI.textField + { pholder = "Comments?" + , inputId = "comment" + , handleInput = State.UpdateTripComment + , inputValue = model.tripComment + } + , UI.baseButton + { enabled = + List.all + identity + [ String.length model.tripDestination > 0 + , String.length model.tripComment > 0 + , ME.isJust model.tripStartDate + , ME.isJust model.tripEndDate + ] + , extraClasses = [ "my-4" ] + , handleClick = + case ( model.tripStartDate, model.tripEndDate ) of + ( Nothing, _ ) -> + State.DoNothing + + ( _, Nothing ) -> + State.DoNothing + + ( Just startDate, Just endDate ) -> + State.AttemptCreateTrip startDate endDate + , label = "Schedule trip" + } + ] + + +trips : State.Model -> Html msg +trips model = + div [] + [ UI.header 3 "Upcoming Trips" + , case model.trips of + RemoteData.NotAsked -> + UI.paragraph "Somehow we've reached the user home page without requesting your trips data. Please report this to our engineering team at bugs@tripplaner.tld" + + RemoteData.Loading -> + UI.paragraph "Loading your trips..." + + RemoteData.Failure e -> + UI.paragraph ("Error: " ++ Utils.explainHttpError e) + + RemoteData.Success xs -> + ul [] + (xs + |> List.map + (\trip -> + li + [ [ "py-2" ] + |> Tailwind.use + |> class + ] + [ text + (Date.toIsoString trip.startDate + ++ " - " + ++ Date.toIsoString trip.endDate + ++ " -> " + ++ trip.destination + ) + ] + ) + ) + ] + + render : State.Model -> Html State.Msg render model = div @@ -23,17 +120,11 @@ render model = ) ] [ UI.header 2 ("Welcome, " ++ model.username ++ "!") - , UI.simpleButton + , createTrip model + , trips model + , UI.textButton { label = "Logout" , handleClick = State.AttemptLogout } - , case model.logoutError of - Nothing -> - text "" - - Just e -> - UI.errorBanner - { title = "Error logging out" - , body = Utils.explainHttpError e - } + , Common.allErrors model ] |