From 6a0c5087f716ed6c876a666db6573491bfd3e094 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 12 Jun 2016 23:54:17 +0200 Subject: Design income form --- src/client/elm/LoggedIn/Home/View/Paging.elm | 8 ++-- src/client/elm/LoggedIn/Income/Model.elm | 24 +++++----- src/client/elm/LoggedIn/Income/View.elm | 66 +++++++++++----------------- src/client/elm/LoggedIn/Msg.elm | 6 +-- src/client/elm/LoggedIn/Update.elm | 10 ++--- src/client/elm/LoggedIn/View/Date.elm | 4 +- src/client/elm/Model/Income.elm | 24 +++++----- src/client/elm/Model/Payer.elm | 4 +- src/client/elm/Model/Payment.elm | 6 +-- src/client/elm/Model/Translations.elm | 2 +- src/client/elm/Server.elm | 20 ++++++--- src/client/elm/Utils/Date.elm | 39 ---------------- src/client/elm/Utils/Http.elm | 14 +++--- src/client/elm/View/Color.elm | 8 ++++ src/client/elm/View/Form.elm | 53 ++++++++++++++++++++++ 15 files changed, 155 insertions(+), 133 deletions(-) delete mode 100644 src/client/elm/Utils/Date.elm create mode 100644 src/client/elm/View/Color.elm create mode 100644 src/client/elm/View/Form.elm (limited to 'src/client') diff --git a/src/client/elm/LoggedIn/Home/View/Paging.elm b/src/client/elm/LoggedIn/Home/View/Paging.elm index 9166d23..fb78810 100644 --- a/src/client/elm/LoggedIn/Home/View/Paging.elm +++ b/src/client/elm/LoggedIn/Home/View/Paging.elm @@ -60,7 +60,7 @@ firstPage homeModel = ] , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| 1) ] - [ FontAwesome.fast_backward grey 20 ] + [ FontAwesome.fast_backward grey 15 ] previousPage : HomeModel.Model -> Html Msg previousPage homeModel = @@ -71,7 +71,7 @@ previousPage homeModel = then (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| homeModel.currentPage - 1) else Msg.NoOp ] - [ FontAwesome.backward grey 20 ] + [ FontAwesome.backward grey 15 ] nextPage : HomeModel.Model -> Int -> Html Msg nextPage homeModel maxPage = @@ -82,7 +82,7 @@ nextPage homeModel maxPage = then (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| homeModel.currentPage + 1) else Msg.NoOp ] - [ FontAwesome.forward grey 20 ] + [ FontAwesome.forward grey 15 ] lastPage : HomeModel.Model -> Int -> Html Msg lastPage homeModel maxPage = @@ -90,7 +90,7 @@ lastPage homeModel maxPage = [ class "page" , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| maxPage) ] - [ FontAwesome.fast_forward grey 20 ] + [ FontAwesome.fast_forward grey 15 ] paymentsPage : HomeModel.Model -> Int -> Html Msg paymentsPage homeModel page = diff --git a/src/client/elm/LoggedIn/Income/Model.elm b/src/client/elm/LoggedIn/Income/Model.elm index bc09f0e..873eaf1 100644 --- a/src/client/elm/LoggedIn/Income/Model.elm +++ b/src/client/elm/LoggedIn/Income/Model.elm @@ -5,20 +5,20 @@ module LoggedIn.Income.Model exposing ) import String exposing (toInt, split) -import Date exposing (Date) +import Date +import Time exposing (Time) import Date.Extra.Create exposing (dateFromFields) -import Utils.Date exposing (numToMonth) +import Date.Extra.Core exposing (intToMonth) import Form exposing (Form) import Form.Validate as Validate exposing (..) -import Form.Error exposing (Error(InvalidString)) type alias Model = - { addIncome : Form () AddIncome + { addIncome : Form String AddIncome } type alias AddIncome = - { creation : Date + { time : Time , amount : Int } @@ -27,20 +27,20 @@ init = { addIncome = Form.initial [] validate } -validate : Validation () AddIncome +validate : Validation String AddIncome validate = form2 AddIncome - (get "creation" dateValidation) + (get "creation" timeValidation) (get "amount" (int `andThen` (minInt 1))) -dateValidation : Validation () Date -dateValidation = +timeValidation : Validation String Time +timeValidation = customValidation string (\str -> case split "/" str of [day, month, year] -> case (toInt day, toInt month, toInt year) of (Ok dayNum, Ok monthNum, Ok yearNum) -> - Ok (dateFromFields yearNum (numToMonth monthNum) dayNum 0 0 0 0) - _ -> Err InvalidString - _ -> Err InvalidString + Ok (Date.toTime (dateFromFields yearNum (intToMonth monthNum) dayNum 0 0 0 0)) + _ -> Err (customError "InvalidDate") + _ -> Err (customError "InvalidDate") ) diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm index 036cd80..d5863ab 100644 --- a/src/client/elm/LoggedIn/Income/View.elm +++ b/src/client/elm/LoggedIn/Income/View.elm @@ -5,13 +5,15 @@ module LoggedIn.Income.View exposing import Dict import Date import Time exposing (Time) +import Color + +import FontAwesome -import Html.App as Html import Html exposing (..) import Html.Events exposing (..) import Html.Attributes exposing (..) +import Html.App as Html import Form exposing (Form) -import Form.Input as Input import Msg exposing (Msg) @@ -29,10 +31,10 @@ import LoggedIn.Income.Msg as IncomeMsg import LoggedIn.View.Date exposing (renderShortDate) import LoggedIn.View.Format as Format -import Utils.Maybe exposing (isJust) - import LoggedIn.View.Date exposing (renderLongDate) import View.Events exposing (onSubmitPrevDefault) +import View.Form as Form +import View.Color as Color view : LoggedData -> IncomeModel.Model -> Html Msg view loggedData incomeModel = @@ -41,9 +43,8 @@ view loggedData incomeModel = [ case useIncomesFrom loggedData.users loggedData.incomes loggedData.payments of Just since -> cumulativeIncomesView loggedData since Nothing -> text "" - , h1 [] [ text <| getMessage "AddIncome" loggedData.translations ] - , addIncomeView loggedData incomeModel.addIncome , h1 [] [ text <| getMessage "MonthlyNetIncomes" loggedData.translations ] + , addIncomeView loggedData incomeModel.addIncome , incomesView loggedData ] @@ -71,45 +72,31 @@ cumulativeIncomesView loggedData since = ) ] -addIncomeView : LoggedData -> Form () IncomeModel.AddIncome -> Html Msg +addIncomeView : LoggedData -> Form String IncomeModel.AddIncome -> Html Msg addIncomeView loggedData addIncome = - let - errorFor error field = - if isJust field.liveError - then div [ class "error" ] [ text (getMessage error loggedData.translations) ] - else text "" - creation = Form.getFieldAsString "creation" addIncome - amount = Form.getFieldAsString "amount" addIncome - htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.IncomeMsg << IncomeMsg.AddIncomeMsg) - in - Html.form - [ onSubmitPrevDefault Msg.NoOp ] - [ label [] [ text (getMessage "Creation" loggedData.translations) ] - , htmlMap <| Input.textInput creation [] - , errorFor "DateValidationError" creation - - , label [] [ text (getMessage "Amount" loggedData.translations) ] - , htmlMap <| Input.textInput amount [] - , errorFor "IncomeValidationError" amount - - , button - [ case Form.getOutput addIncome of - Just data -> - onClick (Msg.UpdateLoggedIn <| LoggedInMsg.AddIncome data.creation data.amount) - Nothing -> - onClick (Msg.UpdateLoggedIn <| LoggedInMsg.IncomeMsg <| IncomeMsg.AddIncomeMsg <| Form.Submit) - ] - [ text (getMessage "Add" loggedData.translations) ] - ] + let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.IncomeMsg << IncomeMsg.AddIncomeMsg) + in Html.form + [ onSubmitPrevDefault Msg.NoOp ] + [ Form.textInput loggedData.translations addIncome htmlMap "creation" + , Form.textInput loggedData.translations addIncome htmlMap "amount" + , button + [ case Form.getOutput addIncome of + Just data -> + onClick (Msg.UpdateLoggedIn <| LoggedInMsg.AddIncome data.time data.amount) + Nothing -> + onClick (Msg.UpdateLoggedIn <| LoggedInMsg.IncomeMsg <| IncomeMsg.AddIncomeMsg <| Form.Submit) + ] + [ text (getMessage "Add" loggedData.translations) ] + ] incomesView : LoggedData -> Html Msg incomesView loggedData = ul - [] + [ class "incomes" ] ( loggedData.incomes |> Dict.toList |> List.filter ((==) loggedData.me << .userId << snd) - |> List.sortBy (.creation << snd) + |> List.sortBy (.time << snd) |> List.reverse |> List.map (incomeView loggedData) ) @@ -118,11 +105,10 @@ incomeView : LoggedData -> (IncomeId, Income) -> Html Msg incomeView loggedData (incomeId, income) = li [] - [ text <| renderShortDate (Date.fromTime income.creation) loggedData.translations + [ text <| renderShortDate (Date.fromTime income.time) loggedData.translations , text " − " , text <| Format.price loggedData.conf income.amount - , text " − " , button [ onClick (Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId) ] - [ text "x" ] + [ FontAwesome.remove Color.chestnutRose 14 ] ] diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm index b83d486..6f6dab0 100644 --- a/src/client/elm/LoggedIn/Msg.elm +++ b/src/client/elm/LoggedIn/Msg.elm @@ -2,7 +2,7 @@ module LoggedIn.Msg exposing ( Msg(..) ) -import Date exposing (Date) +import Time exposing (Time) import Model.Payment exposing (Payment, PaymentId, Frequency) import Model.Income exposing (IncomeId) @@ -21,8 +21,8 @@ type Msg = | DeletePayment PaymentId | ValidateDeletePayment PaymentId - | AddIncome Date Int - | ValidateAddIncome IncomeId Date Int + | AddIncome Time Int + | ValidateAddIncome IncomeId Time Int | DeleteIncome IncomeId | ValidateDeleteIncome IncomeId diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm index 564d6fc..6d8869a 100644 --- a/src/client/elm/LoggedIn/Update.elm +++ b/src/client/elm/LoggedIn/Update.elm @@ -106,16 +106,16 @@ update model action loggedIn = , Cmd.none ) - LoggedInMsg.AddIncome creation amount -> + LoggedInMsg.AddIncome time amount -> ( loggedIn - , Server.addIncome creation amount + , Server.addIncome time amount |> Task.perform (always LoggedInMsg.NoOp) - (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId creation amount)) + (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId time amount)) ) - LoggedInMsg.ValidateAddIncome incomeId creation amount -> - let newIncome = { userId = loggedIn.me, creation = (Date.toTime creation), amount = amount } + LoggedInMsg.ValidateAddIncome incomeId time amount -> + let newIncome = { userId = loggedIn.me, time = time, amount = amount } in ( { loggedIn | incomes = Dict.insert incomeId newIncome loggedIn.incomes } , Cmd.none ) diff --git a/src/client/elm/LoggedIn/View/Date.elm b/src/client/elm/LoggedIn/View/Date.elm index 783f10c..8e4e872 100644 --- a/src/client/elm/LoggedIn/View/Date.elm +++ b/src/client/elm/LoggedIn/View/Date.elm @@ -5,7 +5,7 @@ module LoggedIn.View.Date exposing ) import Date exposing (..) -import Utils.Date exposing (monthToNum) +import Date.Extra.Core as Date import String import Model.Translations exposing (..) @@ -14,7 +14,7 @@ renderShortDate : Date -> Translations -> String renderShortDate date translations = let params = [ String.pad 2 '0' (toString (Date.day date)) - , String.pad 2 '0' (toString (monthToNum (Date.month date))) + , String.pad 2 '0' (toString (Date.monthToInt (Date.month date))) , toString (Date.year date) ] in getParamMessage params "ShortDate" translations diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm index c0039e9..7eaa77f 100644 --- a/src/client/elm/Model/Income.elm +++ b/src/client/elm/Model/Income.elm @@ -25,7 +25,7 @@ type alias IncomeId = Int type alias Income = { userId : UserId - , creation : Time + , time : Float , amount : Int } @@ -45,15 +45,15 @@ incomeDecoder : Json.Decoder Income incomeDecoder = Json.object3 Income ("userId" := userIdDecoder) - ("creation" := timeDecoder) + ("day" := timeDecoder) ("amount" := Json.int) incomeDefinedForAll : List UserId -> Incomes -> Maybe Time incomeDefinedForAll userIds incomes = let userIncomes = List.map (\userId -> List.filter ((==) userId << .userId) << Dict.values <| incomes) userIds - firstIncomes = map (head << sortBy .creation) userIncomes + firstIncomes = map (head << sortBy .time) userIncomes in if all isJust firstIncomes - then head << reverse << List.sort << map .creation << catMaybes <| firstIncomes + then head << reverse << List.sort << map .time << catMaybes <| firstIncomes else Nothing userCumulativeIncomeSince : Time -> Time -> Incomes -> UserId -> Int @@ -70,26 +70,26 @@ cumulativeIncomesSince currentTime since incomes = getOrderedIncomesSince : Time -> List Income -> List Income getOrderedIncomesSince time incomes = let mbStarterIncome = getIncomeAt time incomes - orderedIncomesSince = filter (\income -> income.creation >= time) incomes + orderedIncomesSince = filter (\income -> income.time >= time) incomes in (maybeToList mbStarterIncome) ++ orderedIncomesSince getIncomeAt : Time -> List Income -> Maybe Income getIncomeAt time incomes = case incomes of [x] -> - if x.creation < time - then Just { userId = x.userId, creation = time, amount = x.amount } + if x.time < time + then Just { userId = x.userId, time = time, amount = x.amount } else Nothing x1 :: x2 :: xs -> - if x1.creation < time && x2.creation > time - then Just { userId = x2.userId, creation = time, amount = x2.amount } + if x1.time < time && x2.time > time + then Just { userId = x2.userId, time = time, amount = x2.amount } else getIncomeAt time (x2 :: xs) [] -> Nothing cumulativeIncome : Time -> List Income -> Int cumulativeIncome currentTime incomes = - getIncomesWithDuration currentTime (List.sortBy .creation incomes) + getIncomesWithDuration currentTime (List.sortBy .time incomes) |> map durationIncome |> sum @@ -99,9 +99,9 @@ getIncomesWithDuration currentTime incomes = [] -> [] [income] -> - [(currentTime - income.creation, income.amount)] + [(currentTime - income.time, income.amount)] (income1 :: income2 :: xs) -> - (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs)) + (income2.time - income1.time, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs)) durationIncome : (Float, Int) -> Int durationIncome (duration, income) = diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm index 2c067bc..fb9940a 100644 --- a/src/client/elm/Model/Payer.elm +++ b/src/client/elm/Model/Payer.elm @@ -74,8 +74,8 @@ useIncomesFrom users incomes payments = |> List.map (Date.toTime << .creation) |> List.sort |> List.head - incomesForAllTime = incomeDefinedForAll (Dict.keys users) incomes - in case (firstPaymentTime, incomesForAllTime) of + mbIncomeTime = incomeDefinedForAll (Dict.keys users) incomes + in case (firstPaymentTime, mbIncomeTime) of (Just paymentTime, Just incomeTime) -> Just (max paymentTime incomeTime) _ -> diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm index d9a5d68..7a6c630 100644 --- a/src/client/elm/Model/Payment.elm +++ b/src/client/elm/Model/Payment.elm @@ -15,6 +15,7 @@ module Model.Payment exposing ) import Date exposing (..) +import Date.Extra.Core exposing (monthToInt, intToMonth) import Json.Decode as Json exposing ((:=)) import String @@ -22,7 +23,6 @@ import Model.User exposing (UserId, userIdDecoder) import Model.Date exposing (dateDecoder) import Utils.List as List -import Utils.Date as Date perPage : Int perPage = 8 @@ -91,9 +91,9 @@ monthly userId = List.filter (\p -> p.frequency == Monthly && p.userId == userId groupAndSortByMonth : Payments -> List ((Month, Int), Payments) groupAndSortByMonth payments = payments - |> List.groupBy (\payment -> (Date.year payment.creation, Date.monthToNum << Date.month <| payment.creation)) + |> List.groupBy (\payment -> (Date.year payment.creation, monthToInt << Date.month <| payment.creation)) |> List.sortBy fst - |> List.map (\((year, month), payments) -> ((Date.numToMonth month, year), payments)) + |> List.map (\((year, month), payments) -> ((intToMonth month, year), payments)) |> List.reverse sortedFiltredPunctual : String -> Payments -> Payments diff --git a/src/client/elm/Model/Translations.elm b/src/client/elm/Model/Translations.elm index 705cb66..9499dde 100644 --- a/src/client/elm/Model/Translations.elm +++ b/src/client/elm/Model/Translations.elm @@ -23,7 +23,7 @@ type alias Translation = getTranslation : String -> Translations -> Maybe (List MessagePart) getTranslation key translations = translations - |> List.filter (\translation -> translation.key == key) + |> List.filter (\translation -> String.toLower translation.key == String.toLower key) |> List.head |> Maybe.map .message diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm index d56bc48..dc47007 100644 --- a/src/client/elm/Server.elm +++ b/src/client/elm/Server.elm @@ -9,8 +9,12 @@ module Server exposing import Task as Task exposing (Task) import Http -import Json.Decode as Json exposing ((:=)) -import Date exposing (Date) +import Date +import Json.Decode exposing ((:=)) +import Json.Encode as Json +import Time exposing (Time) + +import Date.Extra.Format as DateFormat import Utils.Http exposing (..) @@ -34,9 +38,15 @@ deletePayment paymentId = delete ("/payment?id=" ++ (toString paymentId)) |> Task.map (always ()) -addIncome : Date -> Int -> Task Http.Error IncomeId -addIncome creation amount = - post ("/income?creation=" ++ (toString << Date.toTime <| creation) ++ "&amount=" ++ (toString amount)) +addIncome : Time -> Int -> Task Http.Error IncomeId +addIncome time amount = + Json.object + [ ("day", Json.string (DateFormat.isoDateString (Date.fromTime time))) + , ("amount", Json.int amount) + ] + |> Json.encode 0 + |> Http.string + |> postWithBody "/income" |> flip Task.andThen (decodeHttpValue <| "id" := incomeIdDecoder) deleteIncome : IncomeId -> Task Http.Error () diff --git a/src/client/elm/Utils/Date.elm b/src/client/elm/Utils/Date.elm deleted file mode 100644 index 352e4ce..0000000 --- a/src/client/elm/Utils/Date.elm +++ /dev/null @@ -1,39 +0,0 @@ -module Utils.Date exposing - ( monthToNum - , numToMonth - ) - -import Date exposing (..) - -monthToNum : Month -> Int -monthToNum month = - case month of - Jan -> 1 - Feb -> 2 - Mar -> 3 - Apr -> 4 - May -> 5 - Jun -> 6 - Jul -> 7 - Aug -> 8 - Sep -> 9 - Oct -> 10 - Nov -> 11 - Dec -> 12 - -numToMonth : Int -> Month -numToMonth n = - case n of - 1 -> Jan - 2 -> Feb - 3 -> Mar - 4 -> Apr - 5 -> May - 6 -> Jun - 7 -> Jul - 8 -> Aug - 9 -> Sep - 10 -> Oct - 11 -> Nov - 12 -> Dec - _ -> Jan diff --git a/src/client/elm/Utils/Http.elm b/src/client/elm/Utils/Http.elm index 97db053..9bcfad7 100644 --- a/src/client/elm/Utils/Http.elm +++ b/src/client/elm/Utils/Http.elm @@ -1,5 +1,6 @@ module Utils.Http exposing ( post + , postWithBody , delete , decodeHttpValue , errorKey @@ -10,17 +11,20 @@ import Task exposing (..) import Json.Decode as Json exposing (Decoder) post : String -> Task Error Value -post = request "POST" +post url = postWithBody url empty + +postWithBody : String -> Body -> Task Error Value +postWithBody = request "POST" delete : String -> Task Error Value -delete = request "DELETE" +delete url = request "DELETE" url empty -request : String -> String -> Task Error Value -request method url = +request : String -> String -> Body -> Task Error Value +request method url body = { verb = method , headers = [] , url = url - , body = empty + , body = body } |> Http.send defaultSettings |> mapError promoteError diff --git a/src/client/elm/View/Color.elm b/src/client/elm/View/Color.elm new file mode 100644 index 0000000..882dd69 --- /dev/null +++ b/src/client/elm/View/Color.elm @@ -0,0 +1,8 @@ +module View.Color exposing + ( chestnutRose + ) + +import Color exposing (Color) + +chestnutRose : Color +chestnutRose = Color.rgb 207 92 86 diff --git a/src/client/elm/View/Form.elm b/src/client/elm/View/Form.elm new file mode 100644 index 0000000..fd21a2c --- /dev/null +++ b/src/client/elm/View/Form.elm @@ -0,0 +1,53 @@ +module View.Form exposing + ( textInput + ) + +import Html exposing (..) +import Html.Attributes exposing (..) + +import Form exposing (Form) +import Form.Input as Input +import Form.Error as FormError exposing (Error(..)) + +import Msg exposing (Msg) + +import LoggedData exposing (LoggedData) + +import Model.Translations as Translations exposing (Translations) + +import Utils.Maybe exposing (isJust) + +textInput : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> Html msg +textInput translations form htmlMap fieldName = + let field = Form.getFieldAsString fieldName form + in div + [ classList + [ ("textInput", True) + , ("error", isJust field.liveError) + ] + ] + [ htmlMap <| + Input.textInput + field + [ id fieldName + , classList [ ("filled", isJust field.value) ] + ] + , label + [ for fieldName ] + [ text (Translations.getMessage fieldName translations) ] + , case field.liveError of + Just error -> errorElement translations error + Nothing -> text "" + ] + +errorElement : Translations -> FormError.Error String -> Html msg +errorElement translations error = + case error of + CustomError key -> + div [ class "errorMessage" ] [ text (Translations.getMessage key translations) ] + SmallerIntThan n -> + div [ class "errorMessage" ] [ text (Translations.getParamMessage [toString n] "SmallerIntThan" translations) ] + GreaterIntThan n -> + div [ class "errorMessage" ] [ text (Translations.getParamMessage [toString n] "GreaterIntThan" translations) ] + error -> + div [ class "errorMessage" ] [ text (Translations.getMessage (toString error) translations) ] -- cgit v1.2.3