Support creating Trips from the frontend
*sigh* ... spent way too much time encoding/decoding date types... I need my database, server, client, and JSON need to agree on types. TL;DR: - Add CSS for elm/datepicker library - Create Common.allErrors to display UI errors - Prefer Data.Time.Calendar.Day instead of newtype Date wrapper around Text
This commit is contained in:
parent
54eb29eae0
commit
249e3113ff
10 changed files with 534 additions and 115 deletions
|
@ -6,6 +6,7 @@
|
||||||
"elm-version": "0.19.1",
|
"elm-version": "0.19.1",
|
||||||
"dependencies": {
|
"dependencies": {
|
||||||
"direct": {
|
"direct": {
|
||||||
|
"CurrySoftware/elm-datepicker": "4.0.0",
|
||||||
"elm/browser": "1.0.2",
|
"elm/browser": "1.0.2",
|
||||||
"elm/core": "1.0.5",
|
"elm/core": "1.0.5",
|
||||||
"elm/html": "1.0.0",
|
"elm/html": "1.0.0",
|
||||||
|
@ -19,6 +20,7 @@
|
||||||
"elm-community/list-extra": "8.2.3",
|
"elm-community/list-extra": "8.2.3",
|
||||||
"elm-community/maybe-extra": "5.2.0",
|
"elm-community/maybe-extra": "5.2.0",
|
||||||
"elm-community/random-extra": "3.1.0",
|
"elm-community/random-extra": "3.1.0",
|
||||||
|
"justinmimbs/date": "3.2.1",
|
||||||
"krisajenkins/remotedata": "6.0.1",
|
"krisajenkins/remotedata": "6.0.1",
|
||||||
"ryannhg/date-format": "2.3.0"
|
"ryannhg/date-format": "2.3.0"
|
||||||
},
|
},
|
||||||
|
|
139
client/index.css
139
client/index.css
|
@ -1,3 +1,142 @@
|
||||||
@tailwind base;
|
@tailwind base;
|
||||||
@tailwind components;
|
@tailwind components;
|
||||||
@tailwind utilities;
|
@tailwind utilities;
|
||||||
|
|
||||||
|
.elm-datepicker--container {
|
||||||
|
position: relative;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--input:focus {
|
||||||
|
outline: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--picker {
|
||||||
|
position: absolute;
|
||||||
|
border: 1px solid #CCC;
|
||||||
|
z-index: 10;
|
||||||
|
background-color: white;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--picker-header,
|
||||||
|
.elm-datepicker--weekdays {
|
||||||
|
background: #F2F2F2;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--picker-header {
|
||||||
|
display: flex;
|
||||||
|
align-items: center;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--prev-container,
|
||||||
|
.elm-datepicker--next-container {
|
||||||
|
flex: 0 1 auto;
|
||||||
|
cursor: pointer;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--month-container {
|
||||||
|
flex: 1 1 auto;
|
||||||
|
padding: 0.5em;
|
||||||
|
display: flex;
|
||||||
|
flex-direction: column;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--month,
|
||||||
|
.elm-datepicker--year {
|
||||||
|
flex: 1 1 auto;
|
||||||
|
cursor: default;
|
||||||
|
text-align: center;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--year {
|
||||||
|
font-size: 0.6em;
|
||||||
|
font-weight: 700;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--prev,
|
||||||
|
.elm-datepicker--next {
|
||||||
|
border: 6px solid transparent;
|
||||||
|
background-color: inherit;
|
||||||
|
display: block;
|
||||||
|
width: 0;
|
||||||
|
height: 0;
|
||||||
|
padding: 0 0.2em;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--prev {
|
||||||
|
border-right-color: #AAA;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--prev:hover {
|
||||||
|
border-right-color: #BBB;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--next {
|
||||||
|
border-left-color: #AAA;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--next:hover {
|
||||||
|
border-left-color: #BBB;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--table {
|
||||||
|
border-spacing: 0;
|
||||||
|
border-collapse: collapse;
|
||||||
|
font-size: 0.8em;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--table td {
|
||||||
|
width: 2em;
|
||||||
|
height: 2em;
|
||||||
|
text-align: center;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--row {
|
||||||
|
border-top: 1px solid #F2F2F2;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--dow {
|
||||||
|
border-bottom: 1px solid #CCC;
|
||||||
|
cursor: default;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--day {
|
||||||
|
cursor: pointer;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--day:hover {
|
||||||
|
background: #F2F2F2;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--disabled {
|
||||||
|
cursor: default;
|
||||||
|
color: #DDD;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--disabled:hover {
|
||||||
|
background: inherit;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--picked {
|
||||||
|
color: white;
|
||||||
|
background: darkblue;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--picked:hover {
|
||||||
|
background: darkblue;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--today {
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--other-month {
|
||||||
|
color: #AAA;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--other-month.elm-datepicker--disabled {
|
||||||
|
color: #EEE;
|
||||||
|
}
|
||||||
|
|
||||||
|
.elm-datepicker--other-month.elm-datepicker--picked {
|
||||||
|
color: white;
|
||||||
|
}
|
||||||
|
|
|
@ -5,6 +5,7 @@ import Html.Attributes exposing (..)
|
||||||
import Html.Events exposing (..)
|
import Html.Events exposing (..)
|
||||||
import RemoteData
|
import RemoteData
|
||||||
import State
|
import State
|
||||||
|
import Common
|
||||||
import Tailwind
|
import Tailwind
|
||||||
import UI
|
import UI
|
||||||
import Utils
|
import Utils
|
||||||
|
@ -78,22 +79,5 @@ render model =
|
||||||
, case model.adminTab of
|
, case model.adminTab of
|
||||||
State.Users ->
|
State.Users ->
|
||||||
allUsers model
|
allUsers model
|
||||||
, case model.logoutError of
|
, Common.allErrors model
|
||||||
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
|
|
||||||
}
|
|
||||||
]
|
]
|
||||||
|
|
27
client/src/Common.elm
Normal file
27
client/src/Common.elm
Normal file
|
@ -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
|
||||||
|
}
|
||||||
|
)
|
||||||
|
)
|
|
@ -1,5 +1,6 @@
|
||||||
module Login exposing (render)
|
module Login exposing (render)
|
||||||
|
|
||||||
|
import Common
|
||||||
import Html exposing (..)
|
import Html exposing (..)
|
||||||
import Html.Attributes exposing (..)
|
import Html.Attributes exposing (..)
|
||||||
import Html.Events exposing (..)
|
import Html.Events exposing (..)
|
||||||
|
@ -137,24 +138,7 @@ login model =
|
||||||
]
|
]
|
||||||
[ UI.header 3 "Welcome to Trip Planner"
|
[ UI.header 3 "Welcome to Trip Planner"
|
||||||
, loginForm model
|
, loginForm model
|
||||||
, case model.loginError of
|
, Common.allErrors model
|
||||||
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
|
|
||||||
}
|
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
@ -174,15 +158,7 @@ logout model =
|
||||||
{ label = "Logout"
|
{ label = "Logout"
|
||||||
, handleClick = State.AttemptLogout
|
, handleClick = State.AttemptLogout
|
||||||
}
|
}
|
||||||
, case model.logoutError of
|
, Common.allErrors model
|
||||||
Nothing ->
|
|
||||||
text ""
|
|
||||||
|
|
||||||
Just e ->
|
|
||||||
UI.errorBanner
|
|
||||||
{ title = "Error logging out"
|
|
||||||
, body = Utils.explainHttpError e
|
|
||||||
}
|
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
module Manager exposing (render)
|
module Manager exposing (render)
|
||||||
|
|
||||||
import Array
|
import Array
|
||||||
|
import Common
|
||||||
import Html exposing (..)
|
import Html exposing (..)
|
||||||
import Html.Attributes exposing (..)
|
import Html.Attributes exposing (..)
|
||||||
import Html.Events exposing (..)
|
import Html.Events exposing (..)
|
||||||
|
@ -33,14 +34,6 @@ render model =
|
||||||
{ label = "Logout"
|
{ label = "Logout"
|
||||||
, handleClick = State.AttemptLogout
|
, handleClick = State.AttemptLogout
|
||||||
}
|
}
|
||||||
, case model.logoutError of
|
, Common.allErrors model
|
||||||
Nothing ->
|
|
||||||
text ""
|
|
||||||
|
|
||||||
Just e ->
|
|
||||||
UI.errorBanner
|
|
||||||
{ title = "Error logging out"
|
|
||||||
, body = Utils.explainHttpError e
|
|
||||||
}
|
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
|
@ -3,6 +3,8 @@ module State exposing (..)
|
||||||
import Array exposing (Array)
|
import Array exposing (Array)
|
||||||
import Browser
|
import Browser
|
||||||
import Browser.Navigation as Nav
|
import Browser.Navigation as Nav
|
||||||
|
import Date
|
||||||
|
import DatePicker
|
||||||
import Http
|
import Http
|
||||||
import Json.Decode as JD
|
import Json.Decode as JD
|
||||||
import Json.Decode.Extra as JDE
|
import Json.Decode.Extra as JDE
|
||||||
|
@ -31,6 +33,10 @@ type Msg
|
||||||
| UpdatePassword String
|
| UpdatePassword String
|
||||||
| UpdateRole String
|
| UpdateRole String
|
||||||
| UpdateAdminTab AdminTab
|
| UpdateAdminTab AdminTab
|
||||||
|
| UpdateTripDestination String
|
||||||
|
| UpdateTripStartDate DatePicker.Msg
|
||||||
|
| UpdateTripEndDate DatePicker.Msg
|
||||||
|
| UpdateTripComment String
|
||||||
| ClearErrors
|
| ClearErrors
|
||||||
| ToggleLoginForm
|
| ToggleLoginForm
|
||||||
-- SPA
|
-- SPA
|
||||||
|
@ -42,12 +48,15 @@ type Msg
|
||||||
| AttemptLogin
|
| AttemptLogin
|
||||||
| AttemptLogout
|
| AttemptLogout
|
||||||
| AttemptDeleteUser String
|
| AttemptDeleteUser String
|
||||||
|
| AttemptCreateTrip Date.Date Date.Date
|
||||||
-- Inbound network
|
-- Inbound network
|
||||||
| GotUsers (WebData AllUsers)
|
| GotUsers (WebData AllUsers)
|
||||||
|
| GotTrips (WebData (List Trip))
|
||||||
| GotSignUp (Result Http.Error Session)
|
| GotSignUp (Result Http.Error Session)
|
||||||
| GotLogin (Result Http.Error Session)
|
| GotLogin (Result Http.Error Session)
|
||||||
| GotLogout (Result Http.Error String)
|
| GotLogout (Result Http.Error String)
|
||||||
| GotDeleteUser (Result Http.Error String)
|
| GotDeleteUser (Result Http.Error String)
|
||||||
|
| CreatedTrip (Result Http.Error ())
|
||||||
|
|
||||||
|
|
||||||
type Route
|
type Route
|
||||||
|
@ -85,13 +94,6 @@ type alias Review =
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
type alias Reviews =
|
|
||||||
{ hi : Maybe Review
|
|
||||||
, lo : Maybe Review
|
|
||||||
, all : List Review
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
type AdminTab
|
type AdminTab
|
||||||
= Users
|
= Users
|
||||||
|
|
||||||
|
@ -101,6 +103,14 @@ type LoginTab
|
||||||
| SignUpForm
|
| SignUpForm
|
||||||
|
|
||||||
|
|
||||||
|
type alias Trip =
|
||||||
|
{ destination : String
|
||||||
|
, startDate : Date.Date
|
||||||
|
, endDate : Date.Date
|
||||||
|
, comment : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
type alias Model =
|
type alias Model =
|
||||||
{ route : Maybe Route
|
{ route : Maybe Route
|
||||||
, url : Url.Url
|
, url : Url.Url
|
||||||
|
@ -111,15 +121,33 @@ type alias Model =
|
||||||
, password : String
|
, password : String
|
||||||
, role : Maybe Role
|
, role : Maybe Role
|
||||||
, users : WebData AllUsers
|
, 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
|
, adminTab : AdminTab
|
||||||
, loginTab : LoginTab
|
, loginTab : LoginTab
|
||||||
, loginError : Maybe Http.Error
|
, loginError : Maybe Http.Error
|
||||||
, logoutError : Maybe Http.Error
|
, logoutError : Maybe Http.Error
|
||||||
, signUpError : Maybe Http.Error
|
, signUpError : Maybe Http.Error
|
||||||
, deleteUserError : 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
|
-- 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 : String -> Cmd Msg
|
||||||
deleteUser username =
|
deleteUser username =
|
||||||
Utils.deleteWithCredentials
|
Utils.deleteWithCredentials
|
||||||
|
@ -239,6 +292,35 @@ decodeReview =
|
||||||
(JD.field "timestamp" JD.string)
|
(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 : Cmd Msg
|
||||||
fetchUsers =
|
fetchUsers =
|
||||||
Utils.getWithCredentials
|
Utils.getWithCredentials
|
||||||
|
@ -301,6 +383,13 @@ routeParser =
|
||||||
-}
|
-}
|
||||||
init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
|
init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
|
||||||
init _ url key =
|
init _ url key =
|
||||||
|
let
|
||||||
|
( startDatePicker, startDatePickerCmd ) =
|
||||||
|
DatePicker.init
|
||||||
|
|
||||||
|
( endDatePicker, endDatePickerCmd ) =
|
||||||
|
DatePicker.init
|
||||||
|
in
|
||||||
( { route = Nothing
|
( { route = Nothing
|
||||||
, url = url
|
, url = url
|
||||||
, key = key
|
, key = key
|
||||||
|
@ -310,14 +399,25 @@ init _ url key =
|
||||||
, password = ""
|
, password = ""
|
||||||
, role = Nothing
|
, role = Nothing
|
||||||
, users = RemoteData.NotAsked
|
, users = RemoteData.NotAsked
|
||||||
|
, tripDestination = ""
|
||||||
|
, tripStartDate = Nothing
|
||||||
|
, tripEndDate = Nothing
|
||||||
|
, tripComment = ""
|
||||||
|
, trips = RemoteData.NotAsked
|
||||||
|
, startDatePicker = startDatePicker
|
||||||
|
, endDatePicker = endDatePicker
|
||||||
, adminTab = Users
|
, adminTab = Users
|
||||||
, loginTab = LoginForm
|
, loginTab = LoginForm
|
||||||
, loginError = Nothing
|
, loginError = Nothing
|
||||||
, logoutError = Nothing
|
, logoutError = Nothing
|
||||||
, signUpError = Nothing
|
, signUpError = Nothing
|
||||||
, deleteUserError = 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
|
in
|
||||||
( { model | role = maybeRole }, Cmd.none )
|
( { 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 ->
|
ClearErrors ->
|
||||||
( { model
|
( { model
|
||||||
| loginError = Nothing
|
| loginError = Nothing
|
||||||
, logoutError = Nothing
|
, logoutError = Nothing
|
||||||
, signUpError = Nothing
|
, signUpError = Nothing
|
||||||
, deleteUserError = Nothing
|
, deleteUserError = Nothing
|
||||||
|
, createTripError = Nothing
|
||||||
}
|
}
|
||||||
, Cmd.none
|
, Cmd.none
|
||||||
)
|
)
|
||||||
|
@ -400,27 +547,18 @@ update msg model =
|
||||||
( { model
|
( { model
|
||||||
| url = url
|
| url = url
|
||||||
, route = route
|
, route = route
|
||||||
|
, trips = RemoteData.Loading
|
||||||
}
|
}
|
||||||
, Cmd.none
|
, fetchTrips
|
||||||
)
|
)
|
||||||
|
|
||||||
Just ManagerHome ->
|
Just ManagerHome ->
|
||||||
case model.session of
|
( { model
|
||||||
Nothing ->
|
| url = url
|
||||||
( { model
|
, route = route
|
||||||
| url = url
|
}
|
||||||
, route = route
|
, Cmd.none
|
||||||
}
|
)
|
||||||
, Cmd.none
|
|
||||||
)
|
|
||||||
|
|
||||||
Just session ->
|
|
||||||
( { model
|
|
||||||
| url = url
|
|
||||||
, route = route
|
|
||||||
}
|
|
||||||
, Cmd.none
|
|
||||||
)
|
|
||||||
|
|
||||||
Just AdminHome ->
|
Just AdminHome ->
|
||||||
( { model
|
( { model
|
||||||
|
@ -439,14 +577,14 @@ update msg model =
|
||||||
, Cmd.none
|
, Cmd.none
|
||||||
)
|
)
|
||||||
|
|
||||||
-- GET /all-usernames
|
-- GET /accounts
|
||||||
AttemptGetUsers ->
|
AttemptGetUsers ->
|
||||||
( { model | users = RemoteData.Loading }, fetchUsers )
|
( { model | users = RemoteData.Loading }, fetchUsers )
|
||||||
|
|
||||||
GotUsers xs ->
|
GotUsers xs ->
|
||||||
( { model | users = xs }, Cmd.none )
|
( { model | users = xs }, Cmd.none )
|
||||||
|
|
||||||
-- DELETE /user/:username
|
-- DELETE /accounts
|
||||||
AttemptDeleteUser username ->
|
AttemptDeleteUser username ->
|
||||||
( model, deleteUser username )
|
( model, deleteUser username )
|
||||||
|
|
||||||
|
@ -460,7 +598,47 @@ update msg model =
|
||||||
, sleepAndClearErrors
|
, 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 ->
|
AttemptSignUp ->
|
||||||
( model
|
( model
|
||||||
, signUp
|
, signUp
|
||||||
|
@ -482,7 +660,11 @@ update msg model =
|
||||||
, sleepAndClearErrors
|
, sleepAndClearErrors
|
||||||
)
|
)
|
||||||
|
|
||||||
-- /login
|
-- GET /trips
|
||||||
|
GotTrips xs ->
|
||||||
|
( { model | trips = xs }, Cmd.none )
|
||||||
|
|
||||||
|
-- POST /login
|
||||||
AttemptLogin ->
|
AttemptLogin ->
|
||||||
( model, login model.username model.password )
|
( model, login model.username model.password )
|
||||||
|
|
||||||
|
@ -498,7 +680,7 @@ update msg model =
|
||||||
, sleepAndClearErrors
|
, sleepAndClearErrors
|
||||||
)
|
)
|
||||||
|
|
||||||
-- / logout
|
-- GET /logout
|
||||||
AttemptLogout ->
|
AttemptLogout ->
|
||||||
( model, logout )
|
( model, logout )
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,7 @@
|
||||||
module UI exposing (..)
|
module UI exposing (..)
|
||||||
|
|
||||||
|
import Date
|
||||||
|
import DatePicker exposing (defaultSettings)
|
||||||
import Html exposing (..)
|
import Html exposing (..)
|
||||||
import Html.Attributes exposing (..)
|
import Html.Attributes exposing (..)
|
||||||
import Html.Events 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 ]
|
||||||
|
|
|
@ -1,9 +1,12 @@
|
||||||
module User exposing (render)
|
module User exposing (render)
|
||||||
|
|
||||||
|
import Common
|
||||||
|
import Date
|
||||||
|
import DatePicker
|
||||||
import Html exposing (..)
|
import Html exposing (..)
|
||||||
import Html.Attributes exposing (..)
|
import Html.Attributes exposing (..)
|
||||||
import Html.Events exposing (..)
|
import Html.Events exposing (..)
|
||||||
import Maybe.Extra
|
import Maybe.Extra as ME
|
||||||
import RemoteData
|
import RemoteData
|
||||||
import State
|
import State
|
||||||
import Tailwind
|
import Tailwind
|
||||||
|
@ -11,6 +14,100 @@ import UI
|
||||||
import Utils
|
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 : State.Model -> Html State.Msg
|
||||||
render model =
|
render model =
|
||||||
div
|
div
|
||||||
|
@ -23,17 +120,11 @@ render model =
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
[ UI.header 2 ("Welcome, " ++ model.username ++ "!")
|
[ UI.header 2 ("Welcome, " ++ model.username ++ "!")
|
||||||
, UI.simpleButton
|
, createTrip model
|
||||||
|
, trips model
|
||||||
|
, UI.textButton
|
||||||
{ label = "Logout"
|
{ label = "Logout"
|
||||||
, handleClick = State.AttemptLogout
|
, handleClick = State.AttemptLogout
|
||||||
}
|
}
|
||||||
, case model.logoutError of
|
, Common.allErrors model
|
||||||
Nothing ->
|
|
||||||
text ""
|
|
||||||
|
|
||||||
Just e ->
|
|
||||||
UI.errorBanner
|
|
||||||
{ title = "Error logging out"
|
|
||||||
, body = Utils.explainHttpError e
|
|
||||||
}
|
|
||||||
]
|
]
|
||||||
|
|
40
src/Types.hs
40
src/Types.hs
|
@ -10,6 +10,7 @@ import Data.Aeson
|
||||||
import Utils
|
import Utils
|
||||||
import Data.Text
|
import Data.Text
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
|
import Data.String.Conversions (cs)
|
||||||
import Database.SQLite.Simple
|
import Database.SQLite.Simple
|
||||||
import Database.SQLite.Simple.Ok
|
import Database.SQLite.Simple.Ok
|
||||||
import Database.SQLite.Simple.FromField
|
import Database.SQLite.Simple.FromField
|
||||||
|
@ -20,6 +21,8 @@ import Servant.API
|
||||||
import System.Envy (FromEnv, fromEnv, env)
|
import System.Envy (FromEnv, fromEnv, env)
|
||||||
import Crypto.Random.Types (MonadRandom)
|
import Crypto.Random.Types (MonadRandom)
|
||||||
|
|
||||||
|
import qualified Data.Time.Calendar as Calendar
|
||||||
|
import qualified Data.Time.Format as TF
|
||||||
import qualified Crypto.KDF.BCrypt as BC
|
import qualified Crypto.KDF.BCrypt as BC
|
||||||
import qualified Data.Time.Clock as Clock
|
import qualified Data.Time.Clock as Clock
|
||||||
import qualified Data.ByteString.Char8 as B
|
import qualified Data.ByteString.Char8 as B
|
||||||
|
@ -192,19 +195,6 @@ instance ToField Comment where
|
||||||
instance FromField Comment where
|
instance FromField Comment where
|
||||||
fromField = forNewtype Comment
|
fromField = forNewtype Comment
|
||||||
|
|
||||||
-- TODO(wpcarro): Replace this with a different type.
|
|
||||||
newtype Date = Date Text
|
|
||||||
deriving (Eq, Show, Generic)
|
|
||||||
|
|
||||||
instance ToJSON Date
|
|
||||||
instance FromJSON Date
|
|
||||||
|
|
||||||
instance ToField Date where
|
|
||||||
toField (Date x) = SQLText x
|
|
||||||
|
|
||||||
instance FromField Date where
|
|
||||||
fromField = forNewtype Date
|
|
||||||
|
|
||||||
newtype Destination = Destination Text
|
newtype Destination = Destination Text
|
||||||
deriving (Eq, Show, Generic)
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
@ -217,11 +207,20 @@ instance ToField Destination where
|
||||||
instance FromField Destination where
|
instance FromField Destination where
|
||||||
fromField = forNewtype Destination
|
fromField = forNewtype Destination
|
||||||
|
|
||||||
|
newtype Year = Year Integer deriving (Eq, Show)
|
||||||
|
newtype Month = Month Integer deriving (Eq, Show)
|
||||||
|
newtype Day = Day Integer deriving (Eq, Show)
|
||||||
|
data Date = Date
|
||||||
|
{ dateYear :: Year
|
||||||
|
, dateMonth :: Month
|
||||||
|
, dateDay :: Day
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
data Trip = Trip
|
data Trip = Trip
|
||||||
{ tripUsername :: Username
|
{ tripUsername :: Username
|
||||||
, tripDestination :: Destination
|
, tripDestination :: Destination
|
||||||
, tripStartDate :: Date
|
, tripStartDate :: Calendar.Day
|
||||||
, tripEndDate :: Date
|
, tripEndDate :: Calendar.Day
|
||||||
, tripComment :: Comment
|
, tripComment :: Comment
|
||||||
} deriving (Eq, Show, Generic)
|
} deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
@ -238,10 +237,10 @@ instance FromRow Trip where
|
||||||
data TripPK = TripPK
|
data TripPK = TripPK
|
||||||
{ tripPKUsername :: Username
|
{ tripPKUsername :: Username
|
||||||
, tripPKDestination :: Destination
|
, tripPKDestination :: Destination
|
||||||
, tripPKStartDate :: Date
|
, tripPKStartDate :: Clock.UTCTime
|
||||||
} deriving (Eq, Show, Generic)
|
} deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
tripPKFields :: TripPK -> (Username, Destination, Date)
|
tripPKFields :: TripPK -> (Username, Destination, Clock.UTCTime)
|
||||||
tripPKFields (TripPK{..})
|
tripPKFields (TripPK{..})
|
||||||
= (tripPKUsername, tripPKDestination, tripPKStartDate)
|
= (tripPKUsername, tripPKDestination, tripPKStartDate)
|
||||||
|
|
||||||
|
@ -253,7 +252,8 @@ instance FromJSON TripPK where
|
||||||
pure TripPK{..}
|
pure TripPK{..}
|
||||||
|
|
||||||
-- | Return the tuple representation of a Trip record for SQL.
|
-- | Return the tuple representation of a Trip record for SQL.
|
||||||
tripFields :: Trip -> (Username, Destination, Date, Date, Comment)
|
tripFields :: Trip
|
||||||
|
-> (Username, Destination, Calendar.Day, Calendar.Day, Comment)
|
||||||
tripFields (Trip{..})
|
tripFields (Trip{..})
|
||||||
= ( tripUsername
|
= ( tripUsername
|
||||||
, tripDestination
|
, tripDestination
|
||||||
|
@ -436,8 +436,8 @@ instance FromRow PendingAccount where
|
||||||
data UpdateTripRequest = UpdateTripRequest
|
data UpdateTripRequest = UpdateTripRequest
|
||||||
{ updateTripRequestTripPK :: TripPK
|
{ updateTripRequestTripPK :: TripPK
|
||||||
, updateTripRequestDestination :: Maybe Destination
|
, updateTripRequestDestination :: Maybe Destination
|
||||||
, updateTripRequestStartDate :: Maybe Date
|
, updateTripRequestStartDate :: Maybe Calendar.Day
|
||||||
, updateTripRequestEndDate :: Maybe Date
|
, updateTripRequestEndDate :: Maybe Calendar.Day
|
||||||
, updateTripRequestComment :: Maybe Comment
|
, updateTripRequestComment :: Maybe Comment
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue