aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoris2016-06-23 23:43:23 +0200
committerJoris2016-06-23 23:43:23 +0200
commit4ce4de89a5400b0d8b9cddaa2922901a081fdaaa (patch)
treeb65e9ef809c2ec7608101563eb3378eaeeddf12b
parent36a90770ebeb9bd99e136bfe035fdda5dfabc304 (diff)
downloadbudget-4ce4de89a5400b0d8b9cddaa2922901a081fdaaa.tar.gz
budget-4ce4de89a5400b0d8b9cddaa2922901a081fdaaa.tar.bz2
budget-4ce4de89a5400b0d8b9cddaa2922901a081fdaaa.zip
Use a dialog to add a payment
-rw-r--r--src/client/elm/Dialog.elm30
-rw-r--r--src/client/elm/LoggedIn/Home/AddPayment/Model.elm29
-rw-r--r--src/client/elm/LoggedIn/Home/AddPayment/Msg.elm14
-rw-r--r--src/client/elm/LoggedIn/Home/AddPayment/Update.elm58
-rw-r--r--src/client/elm/LoggedIn/Home/AddPayment/View.elm164
-rw-r--r--src/client/elm/LoggedIn/Home/Model.elm43
-rw-r--r--src/client/elm/LoggedIn/Home/Msg.elm4
-rw-r--r--src/client/elm/LoggedIn/Home/Search/View.elm8
-rw-r--r--src/client/elm/LoggedIn/Home/Update.elm14
-rw-r--r--src/client/elm/LoggedIn/Home/View.elm4
-rw-r--r--src/client/elm/LoggedIn/Income/View.elm3
-rw-r--r--src/client/elm/LoggedIn/Msg.elm2
-rw-r--r--src/client/elm/LoggedIn/Update.elm56
-rw-r--r--src/client/elm/Server.elm4
-rw-r--r--src/client/elm/Update.elm2
-rw-r--r--src/client/elm/View.elm3
-rw-r--r--src/client/elm/View/Form.elm41
-rw-r--r--src/server/Design/Form.hs22
-rw-r--r--src/server/Design/LoggedIn/Home/Search.hs12
-rw-r--r--src/server/Design/LoggedIn/Home/Table.hs36
-rw-r--r--src/server/Model/Message/Key.hs7
-rw-r--r--src/server/Model/Message/Translations.hs42
22 files changed, 258 insertions, 340 deletions
diff --git a/src/client/elm/Dialog.elm b/src/client/elm/Dialog.elm
index 0fb43db..4b5b4cd 100644
--- a/src/client/elm/Dialog.elm
+++ b/src/client/elm/Dialog.elm
@@ -8,7 +8,7 @@ module Dialog exposing
)
import Platform.Cmd exposing (Cmd)
-import Task
+import Task exposing (Task)
import Html exposing (..)
import Html.Attributes exposing (..)
@@ -25,7 +25,7 @@ type alias Config model msg =
{ title : String
, body : model -> Html msg
, confirm : String
- , confirmMsg : msg
+ , confirmMsg : model -> Result msg msg
, undo : String
}
@@ -39,12 +39,12 @@ init mapMsg =
type Msg model msg =
NoOp
- | ConfirmMsg msg
+ | ConfirmMsg (model -> Result msg msg)
| Open (Config model msg)
| Close
-update : Msg model msg -> Model model msg -> (Model model msg, Cmd msg)
-update msg model =
+update : Msg model msg -> model -> Model model msg -> (Model model msg, Cmd msg)
+update msg baseModel model =
case msg of
NoOp ->
( model
@@ -52,10 +52,15 @@ update msg model =
)
ConfirmMsg confirmMsg ->
- ( { model | config = Nothing }
- , Task.succeed msg
- |> Task.perform (always confirmMsg) (always confirmMsg)
- )
+ case confirmMsg baseModel of
+ Ok msg ->
+ ( { model | config = Nothing }
+ , Task.perform (always msg) (always msg) (Task.succeed NoOp)
+ )
+ Err msg ->
+ ( model
+ , Task.perform (always msg) (always msg) (Task.succeed NoOp)
+ )
Open config ->
( { model | config = Just config }
@@ -90,7 +95,7 @@ curtain mapMsg isVisible =
div
[ class "curtain"
, style
- [ ("position", "absolute")
+ [ ("position", "fixed")
, ("top", "0")
, ("left", "0")
, ("width", "100%")
@@ -109,11 +114,10 @@ dialog model mapMsg { title, body, confirm, confirmMsg, undo } =
div
[ class "content"
, style
- [ ("min-width", "300px")
- , ("position", "absolute")
+ [ ("position", "fixed")
, ("top", "25%")
, ("left", "50%")
- , ("transform", "translate(-50%, -50%)")
+ , ("transform", "translate(-50%, -25%)")
, ("z-index", "1000")
, ("background-color", "white")
, ("padding", "20px")
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Model.elm b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm
deleted file mode 100644
index b656077..0000000
--- a/src/client/elm/LoggedIn/Home/AddPayment/Model.elm
+++ /dev/null
@@ -1,29 +0,0 @@
-module LoggedIn.Home.AddPayment.Model exposing
- ( Model
- , init
- )
-
-import Result as Result exposing (Result(..))
-import Json.Decode exposing ((:=))
-
-import Model.Translations exposing (..)
-import Model.Payment exposing (Frequency(..))
-
-type alias Model =
- { name : String
- , nameError : Maybe String
- , cost : String
- , costError : Maybe String
- , frequency : Frequency
- , waitingServer : Bool
- }
-
-init : Frequency -> Model
-init frequency =
- { name = ""
- , nameError = Nothing
- , cost = ""
- , costError = Nothing
- , frequency = frequency
- , waitingServer = False
- }
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Msg.elm b/src/client/elm/LoggedIn/Home/AddPayment/Msg.elm
deleted file mode 100644
index 53e6e26..0000000
--- a/src/client/elm/LoggedIn/Home/AddPayment/Msg.elm
+++ /dev/null
@@ -1,14 +0,0 @@
-module LoggedIn.Home.AddPayment.Msg exposing
- ( Msg(..)
- )
-
-import Model.Payment exposing (Frequency)
-
-type Msg =
- NoOp
- | Init Frequency
- | UpdateName String
- | UpdateCost String
- | AddError (Maybe String) (Maybe String)
- | ToggleFrequency
- | WaitingServer
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Update.elm b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm
deleted file mode 100644
index dc1ea57..0000000
--- a/src/client/elm/LoggedIn/Home/AddPayment/Update.elm
+++ /dev/null
@@ -1,58 +0,0 @@
-module LoggedIn.Home.AddPayment.Update exposing
- ( update
- , addPaymentError
- )
-
-import Maybe
-import Json.Decode as Json exposing ((:=))
-
-import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
-import LoggedIn.Home.AddPayment.Model as AddPaymentModel
-
-import Model.Translations exposing (Translations, getMessage)
-import Model.Payment exposing (Frequency(..))
-
-update : AddPaymentMsg.Msg -> AddPaymentModel.Model -> AddPaymentModel.Model
-update msg addPayment =
- case msg of
-
- AddPaymentMsg.NoOp ->
- addPayment
-
- AddPaymentMsg.Init frequency ->
- AddPaymentModel.init frequency
-
- AddPaymentMsg.UpdateName name ->
- { addPayment | name = name }
-
- AddPaymentMsg.UpdateCost cost ->
- { addPayment | cost = cost }
-
- AddPaymentMsg.AddError nameError costError ->
- { addPayment
- | nameError = nameError
- , costError = costError
- , waitingServer = False
- }
-
- AddPaymentMsg.ToggleFrequency ->
- { addPayment
- | frequency = if addPayment.frequency == Punctual then Monthly else Punctual
- }
-
- AddPaymentMsg.WaitingServer ->
- { addPayment | waitingServer = True }
-
-addPaymentError : Translations -> String -> Maybe AddPaymentMsg.Msg
-addPaymentError translations jsonErr =
- let decoder =
- Json.object2 (,)
- (Json.maybe <| "name" := Json.string)
- (Json.maybe <| "cost" := Json.string)
- in case Json.decodeString decoder jsonErr of
- Err _ ->
- Nothing
- Ok (mbNameKey, mbCostKey) ->
- Just <| AddPaymentMsg.AddError
- (Maybe.map (flip getMessage translations) mbNameKey)
- (Maybe.map (flip getMessage translations) mbCostKey)
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/View.elm b/src/client/elm/LoggedIn/Home/AddPayment/View.elm
index b13097b..5ccdb35 100644
--- a/src/client/elm/LoggedIn/Home/AddPayment/View.elm
+++ b/src/client/elm/LoggedIn/Home/AddPayment/View.elm
@@ -2,133 +2,67 @@ module LoggedIn.Home.AddPayment.View exposing
( view
)
-import Result exposing (..)
-import Json.Decode as Json
-import Color
-
-import FontAwesome
-
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
+import Html.App as Html
+import Task
-import Msg exposing (Msg)
-
-import LoggedIn.Msg as LoggedInMsg
+import Form exposing (Form)
-import LoggedIn.Home.Msg as HomeMsg
-import LoggedIn.Home.Model as HomeModel
-
-import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
-import LoggedIn.Home.AddPayment.Model as AddPaymentModel
-
-import Model.Payment exposing (Frequency(..))
-import Model.Translations exposing (getMessage)
-import LoggedData exposing (LoggedData)
+import Dialog
+import View.Form as Form
import View.Events exposing (onSubmitPrevDefault)
-import Utils.Maybe exposing (isJust)
-import Utils.Either exposing (toMaybeError)
+import Msg exposing (Msg)
+import LoggedIn.Msg as LoggedInMsg
+import LoggedIn.Home.Msg as HomeMsg
-view : LoggedData -> HomeModel.Model -> Html Msg
-view loggedData homeModel =
- Html.form
- [ let update =
- if homeModel.add.waitingServer
- then
- Msg.NoOp
- else
- Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment homeModel.add.name homeModel.add.cost homeModel.add.frequency
- in onSubmitPrevDefault update
- , class "addPayment"
- ]
- [ addPaymentName loggedData homeModel.add
- , addPaymentCost loggedData homeModel.add
- , paymentFrequency loggedData homeModel.add
- , button
- [ type' "submit"
- , classList
- [ ("add", True)
- , ("waitingServer", homeModel.add.waitingServer)
- ]
- ]
- [ text (getMessage "Add" loggedData.translations)
- , if homeModel.add.waitingServer
- then FontAwesome.spinner Color.white 20
- else text ""
- ]
- ]
+import Model.Translations exposing (getMessage)
+import Model.Payment as Payment
+import Model.View exposing (View(LoggedInView))
-addPaymentName : LoggedData -> AddPaymentModel.Model -> Html Msg
-addPaymentName loggedData addPayment =
- div
- [ classList
- [ ("name", True)
- , ("error", isJust addPayment.nameError)
- ]
- ]
- [ input
- [ id "nameInput"
- , value addPayment.name
- , on "input" (targetValue |> (Json.map <| Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdateAdd << AddPaymentMsg.UpdateName))
- , maxlength 20
- ]
- []
- , label
- [ for "nameInput" ]
- [ FontAwesome.shopping_cart Color.white 20 ]
- , case addPayment.nameError of
- Just error ->
- div [ class "errorMessage" ] [ text error ]
- Nothing ->
- text ""
- ]
+import LoggedData exposing (LoggedData)
+import LoggedIn.Home.Model as HomeModel
-addPaymentCost : LoggedData -> AddPaymentModel.Model -> Html Msg
-addPaymentCost loggedData addPayment =
- div
- [ classList
- [ ("cost", True)
- , ("error", isJust addPayment.costError)
- ]
- ]
- [ input
- [ id "costInput"
- , value addPayment.cost
- , on "input" (targetValue |> (Json.map <| Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdateAdd << AddPaymentMsg.UpdateCost))
- , maxlength 7
+view : LoggedData -> Html Msg
+view loggedData =
+ let dialogConfig =
+ { title = getMessage "AddPayment" loggedData.translations
+ , body = \view -> (
+ case view of
+ LoggedInView loggedIn -> addPaymentForm loggedData loggedIn.home
+ _ -> text ""
+ )
+ , confirm = getMessage "Confirm" loggedData.translations
+ , confirmMsg = \view -> (
+ case view of
+ LoggedInView loggedIn ->
+ case Form.getOutput loggedIn.home.addPayment of
+ Just data ->
+ Ok (Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment data.name data.cost data.frequency)
+ Nothing ->
+ Err (Msg.UpdateLoggedIn <| LoggedInMsg.HomeMsg <| HomeMsg.AddPaymentMsg <| Form.Submit)
+ _ ->
+ Err (Msg.UpdateLoggedIn LoggedInMsg.NoOp)
+ )
+ , undo = getMessage "Undo" loggedData.translations
+ }
+ in button
+ [ class "addPayment"
+ , onClick (Msg.Dialog <| Dialog.Open dialogConfig)
]
- []
- , label
- [ for "costInput" ]
- [ text loggedData.conf.currency ]
- , case addPayment.costError of
- Just error ->
- div [ class "errorMessage" ] [ text error ]
- Nothing ->
- text ""
- ]
+ [ text (getMessage "AddPayment" loggedData.translations) ]
-paymentFrequency : LoggedData -> AddPaymentModel.Model -> Html Msg
-paymentFrequency loggedData addPayment =
- button
- [ type' "button"
- , class "frequency"
- , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdateAdd <| AddPaymentMsg.ToggleFrequency)
- ]
- [ div
- [ classList
- [ ("punctual", True)
- , ("selected", addPayment.frequency == Punctual)
- ]
+addPaymentForm : LoggedData -> HomeModel.Model -> Html Msg
+addPaymentForm loggedData { addPayment } =
+ let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.AddPaymentMsg)
+ in Html.form
+ [ class "addPayment"
+ , onSubmitPrevDefault Msg.NoOp
]
- [ text (getMessage "Punctual" loggedData.translations) ]
- , div
- [ classList
- [ ("monthly", True)
- , ("selected", addPayment.frequency == Monthly)
- ]
+ [ Form.textInput loggedData.translations addPayment htmlMap "name"
+ , Form.textInput loggedData.translations addPayment htmlMap "cost"
+ , Form.radioInputs loggedData.translations addPayment htmlMap "frequency" [ toString Payment.Punctual, toString Payment.Monthly ]
]
- [ text (getMessage "Monthly" loggedData.translations) ]
- ]
diff --git a/src/client/elm/LoggedIn/Home/Model.elm b/src/client/elm/LoggedIn/Home/Model.elm
index 6b29d8c..e802828 100644
--- a/src/client/elm/LoggedIn/Home/Model.elm
+++ b/src/client/elm/LoggedIn/Home/Model.elm
@@ -2,39 +2,64 @@ module LoggedIn.Home.Model exposing
( Model
, Search
, init
+ , addPaymentInitial
)
import Form exposing (Form)
import Form.Validate as Validate exposing (Validation)
+import Form.Field as Field exposing (Field)
import Model.User exposing (Users, UserId)
import Model.Payment exposing (PaymentId, Payments, Frequency(..))
import Model.Payer exposing (Payers)
-import LoggedIn.Home.AddPayment.Model as AddPaymentModel
-
type alias Model =
- { add : AddPaymentModel.Model
- , paymentEdition : Maybe PaymentId
+ { paymentEdition : Maybe PaymentId
, currentPage : Int
, monthlyDetail : Bool
, search : Form String Search
+ , addPayment : Form String AddPayment
}
type alias Search =
{ searchText : Maybe String
}
+type alias AddPayment =
+ { name : String
+ , cost : Int
+ , frequency : Frequency
+ }
+
init : Model
init =
- { add = AddPaymentModel.init Punctual
- , paymentEdition = Nothing
+ { paymentEdition = Nothing
, currentPage = 1
, monthlyDetail = False
- , search = Form.initial [] validate
+ , search = Form.initial [] searchValidation
+ , addPayment = Form.initial addPaymentInitial addPaymentValidation
}
-validate : Validation String Search
-validate =
+searchValidation : Validation String Search
+searchValidation =
Validate.form1 Search
(Validate.get "searchText" (Validate.maybe Validate.string))
+
+addPaymentInitial : List (String, Field)
+addPaymentInitial = [ ("frequency", Field.Radio (toString Punctual)) ]
+
+addPaymentValidation : Validation String AddPayment
+addPaymentValidation =
+ Validate.form3 AddPayment
+ (Validate.get "name" (Validate.string `Validate.andThen` (Validate.nonEmpty)))
+ (Validate.get "cost" (Validate.int `Validate.andThen` (Validate.minInt 1)))
+ (Validate.get "frequency" validateFrequency)
+
+validateFrequency : Validation String Frequency
+validateFrequency =
+ Validate.customValidation Validate.string (\str ->
+ case str of
+ "Punctual" -> Ok Punctual
+ "Monthly" -> Ok Monthly
+ _ -> Err (Validate.customError "InvalidFrequency")
+ )
diff --git a/src/client/elm/LoggedIn/Home/Msg.elm b/src/client/elm/LoggedIn/Home/Msg.elm
index 17a88f8..bb6f77d 100644
--- a/src/client/elm/LoggedIn/Home/Msg.elm
+++ b/src/client/elm/LoggedIn/Home/Msg.elm
@@ -6,13 +6,11 @@ import Form exposing (Form)
import Model.Payment exposing (PaymentId)
-import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
-
type Msg =
NoOp
- | UpdateAdd AddPaymentMsg.Msg
| ToggleEdit PaymentId
| UpdatePage Int
| ShowMonthlyDetail
| ToggleMonthlyDetail
| SearchMsg Form.Msg
+ | AddPaymentMsg Form.Msg
diff --git a/src/client/elm/LoggedIn/Home/Search/View.elm b/src/client/elm/LoggedIn/Home/Search/View.elm
index f06377d..99eec95 100644
--- a/src/client/elm/LoggedIn/Home/Search/View.elm
+++ b/src/client/elm/LoggedIn/Home/Search/View.elm
@@ -19,6 +19,9 @@ import LoggedIn.Home.Model as HomeModel
import Model.Translations exposing (getParamMessage)
import Model.Conf exposing (Conf)
import Model.Payment exposing (Payments)
+import Model.Translations exposing (getMessage)
+
+import LoggedIn.Home.AddPayment.View as AddPayment
import LoggedIn.View.Format as Format
import View.Plural exposing (plural)
@@ -29,6 +32,7 @@ view loggedData { search } payments =
[ class "search" ]
[ searchForm loggedData search
, paymentsStat loggedData payments
+ , AddPayment.view loggedData
]
searchForm : LoggedData -> Form String HomeModel.Search -> Html Msg
@@ -40,7 +44,9 @@ paymentsStat : LoggedData -> Payments -> Html Msg
paymentsStat loggedData payments =
let count = plural loggedData.translations (List.length payments) "Payment" "Payments"
sum = paymentsSum loggedData.conf payments
- in text <| getParamMessage [ count, sum ] "Worth" loggedData.translations
+ in span
+ [ class "stat" ]
+ [ text <| getParamMessage [ count, sum ] "Worth" loggedData.translations ]
paymentsSum : Conf -> Payments -> String
paymentsSum conf payments =
diff --git a/src/client/elm/LoggedIn/Home/Update.elm b/src/client/elm/LoggedIn/Home/Update.elm
index af3504a..562cd20 100644
--- a/src/client/elm/LoggedIn/Home/Update.elm
+++ b/src/client/elm/LoggedIn/Home/Update.elm
@@ -9,19 +9,12 @@ import LoggedData exposing (LoggedData)
import LoggedIn.Home.Msg as HomeMsg
import LoggedIn.Home.Model as HomeModel
-import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate
-
update : LoggedData -> HomeMsg.Msg -> HomeModel.Model -> (HomeModel.Model, Cmd HomeMsg.Msg)
update loggedData msg homeModel =
case msg of
HomeMsg.NoOp -> (homeModel, Cmd.none)
- HomeMsg.UpdateAdd addPaymentMsg ->
- ( { homeModel | add = AddPaymentUpdate.update addPaymentMsg homeModel.add }
- , Cmd.none
- )
-
HomeMsg.ToggleEdit id ->
( { homeModel | paymentEdition = if homeModel.paymentEdition == Just id then Nothing else Just id }
, Cmd.none
@@ -52,3 +45,10 @@ update loggedData msg homeModel =
}
, Cmd.none
)
+
+ HomeMsg.AddPaymentMsg formMsg ->
+ ( { homeModel
+ | addPayment = Form.update formMsg homeModel.addPayment
+ }
+ , Cmd.none
+ )
diff --git a/src/client/elm/LoggedIn/Home/View.elm b/src/client/elm/LoggedIn/Home/View.elm
index 82ec8a3..8076673 100644
--- a/src/client/elm/LoggedIn/Home/View.elm
+++ b/src/client/elm/LoggedIn/Home/View.elm
@@ -16,7 +16,6 @@ import Model.Payment as Payment
import LoggedIn.Home.Model as LoggedInModel
import LoggedIn.Home.Search.View as SearchView
-import LoggedIn.Home.AddPayment.View as AddPaymentView
import LoggedIn.Home.View.Monthly as MonthlyView
import LoggedIn.Home.View.Table exposing (paymentsTable)
@@ -27,9 +26,8 @@ view loggedData loggedIn =
let punctualPayments = Payment.sortedFiltredPunctual (Form.fieldAsText loggedIn.search "searchText") loggedData.payments
in div
[ class "home" ]
- [ AddPaymentView.view loggedData loggedIn
+ [ SearchView.view loggedData loggedIn punctualPayments
, MonthlyView.view loggedData loggedIn
- , SearchView.view loggedData loggedIn punctualPayments
, paymentsTable loggedData loggedIn punctualPayments
, paymentsPaging loggedIn punctualPayments
]
diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm
index 7970284..25cb5a6 100644
--- a/src/client/elm/LoggedIn/Income/View.elm
+++ b/src/client/elm/LoggedIn/Income/View.elm
@@ -6,6 +6,7 @@ import Dict
import Date
import Time exposing (Time)
import Color
+import Task
import FontAwesome
@@ -114,7 +115,7 @@ incomeView loggedData (incomeId, income) =
{ title = getMessage "ConfirmDelete" loggedData.translations
, body = always <| text ""
, confirm = getMessage "Confirm" loggedData.translations
- , confirmMsg = Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId
+ , confirmMsg = always <| Ok <| Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId
, undo = getMessage "Undo" loggedData.translations
}
in button
diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm
index 6f6dab0..c09655f 100644
--- a/src/client/elm/LoggedIn/Msg.elm
+++ b/src/client/elm/LoggedIn/Msg.elm
@@ -15,7 +15,7 @@ type Msg =
| HomeMsg HomeMsg.Msg
| IncomeMsg IncomeMsg.Msg
- | AddPayment String String Frequency
+ | AddPayment String Int Frequency
| ValidateAddPayment PaymentId String Int Frequency
| DeletePayment PaymentId
diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm
index 7133786..4fddc2c 100644
--- a/src/client/elm/LoggedIn/Update.elm
+++ b/src/client/elm/LoggedIn/Update.elm
@@ -10,6 +10,8 @@ import Http exposing (Error(..))
import Date exposing (Date)
import Platform.Cmd exposing (Cmd)
+import Form
+
import Model exposing (Model)
import Model.Translations exposing (getMessage)
import Model.Payment exposing (Payment, Frequency(..), deletePayment)
@@ -22,13 +24,11 @@ import LoggedIn.Model as LoggedInModel
import LoggedIn.Home.Msg as HomeMsg
import LoggedIn.Home.Update as HomeUpdate
+import LoggedIn.Home.Model as HomeModel
import LoggedIn.Income.Msg as IncomeMsg
import LoggedIn.Income.Update as IncomeUpdate
-import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
-import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate
-
import LoggedIn.Income.Model as IncomeModel
import Utils.Tuple as Tuple
@@ -40,7 +40,9 @@ update model msg loggedIn =
in case msg of
LoggedInMsg.NoOp ->
- (loggedIn, Cmd.none)
+ ( loggedIn
+ , Cmd.none
+ )
LoggedInMsg.HomeMsg homeMsg ->
case HomeUpdate.update loggedData homeMsg loggedIn.home of
@@ -57,37 +59,27 @@ update model msg loggedIn =
)
LoggedInMsg.AddPayment name cost frequency ->
- update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd <| AddPaymentMsg.WaitingServer) loggedIn
- :> \loggedIn ->
- Server.addPayment name cost frequency
- |> Task.perform
- (\err ->
- case err of
- BadResponse 400 jsonErr ->
- case AddPaymentUpdate.addPaymentError model.translations jsonErr of
- Just addPaymentMsg -> (LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd addPaymentMsg)
- Nothing -> LoggedInMsg.NoOp
- _ ->
- LoggedInMsg.NoOp
- )
- (\paymentId ->
- case String.toInt cost of
- Err _ ->
- LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd (AddPaymentMsg.AddError Nothing (Just (getMessage "CostRequired" loggedData.translations)))
- Ok costNumber ->
- LoggedInMsg.ValidateAddPayment paymentId name costNumber frequency
- )
- |> \cmd -> (loggedIn, cmd)
+ Server.addPayment name cost frequency
+ |> Task.perform
+ (\err ->
+ case err of
+ BadResponse 400 jsonErr ->
+ LoggedInMsg.NoOp
+ _ ->
+ LoggedInMsg.NoOp
+ )
+ (\paymentId -> LoggedInMsg.ValidateAddPayment paymentId name cost frequency)
+ |> \cmd -> (loggedIn, cmd)
LoggedInMsg.ValidateAddPayment paymentId name cost frequency ->
- update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd <| AddPaymentMsg.Init frequency) loggedIn
+ update model (LoggedInMsg.HomeMsg <| HomeMsg.AddPaymentMsg (Form.Reset HomeModel.addPaymentInitial)) loggedIn
:> (\loggedIn ->
- case frequency of
- Punctual ->
- update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdatePage 1) loggedIn
- Monthly ->
- update model (LoggedInMsg.HomeMsg <| HomeMsg.ShowMonthlyDetail) loggedIn
- )
+ case frequency of
+ Punctual ->
+ update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdatePage 1) loggedIn
+ Monthly ->
+ update model (LoggedInMsg.HomeMsg <| HomeMsg.ShowMonthlyDetail) loggedIn
+ )
:> (\loggedIn ->
let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedIn.me frequency
in ( { loggedIn | payments = newPayment :: loggedIn.payments }
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index dc47007..f3ed949 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -28,9 +28,9 @@ signIn email =
post ("/signIn?email=" ++ email)
|> Task.map (always ())
-addPayment : String -> String -> Frequency -> Task Http.Error PaymentId
+addPayment : String -> Int -> Frequency -> Task Http.Error PaymentId
addPayment name cost frequency =
- post ("/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency))
+ post ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency))
|> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
deletePayment : PaymentId -> Task Http.Error ()
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
index db8889f..d3e82de 100644
--- a/src/client/elm/Update.elm
+++ b/src/client/elm/Update.elm
@@ -68,7 +68,7 @@ update msg model =
)
Dialog dialogMsg ->
- let (newDialog, command) = Dialog.update dialogMsg model.dialog
+ let (newDialog, command) = Dialog.update dialogMsg model.view model.dialog
in ( { model | dialog = newDialog }
, command
)
diff --git a/src/client/elm/View.elm b/src/client/elm/View.elm
index f4b0953..4e97472 100644
--- a/src/client/elm/View.elm
+++ b/src/client/elm/View.elm
@@ -4,6 +4,7 @@ module View exposing
import Html exposing (..)
import Html.App as Html
+import Html.Attributes exposing (..)
import Model exposing (Model)
import Msg exposing (Msg)
@@ -16,6 +17,8 @@ import View.Header exposing (renderHeader)
import SignIn.View as SignInView
import LoggedIn.View as LoggedInView
+import Utils.Maybe as Maybe
+
view : Model -> Html Msg
view model =
div
diff --git a/src/client/elm/View/Form.elm b/src/client/elm/View/Form.elm
index a85ba8a..5471e7d 100644
--- a/src/client/elm/View/Form.elm
+++ b/src/client/elm/View/Form.elm
@@ -1,11 +1,12 @@
module View.Form exposing
( textInput
+ , radioInputs
)
import Html exposing (..)
import Html.Attributes exposing (..)
-import Form exposing (Form)
+import Form exposing (Form, FieldState)
import Form.Input as Input
import Form.Error as FormError exposing (Error(..))
@@ -40,29 +41,41 @@ textInput translations form htmlMap fieldName =
Nothing -> text ""
]
-simpleTextInput : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> Html msg
-simpleTextInput translations form htmlMap fieldName =
- let field = Form.getFieldAsString fieldName form
+radioInputs : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> List String -> Html msg
+radioInputs translations form htmlMap radioName fieldNames =
+ let field = Form.getFieldAsString radioName form
in div
[ classList
- [ ("textInput", True)
+ [ ("radioGroup", True)
, ("error", isJust field.liveError)
]
]
- [ htmlMap <|
- Input.textInput
- field
- [ id fieldName
- , classList [ ("filled", isJust field.value) ]
- ]
- , label
- [ for fieldName ]
- [ text (Translations.getMessage fieldName translations) ]
+ [ div
+ [ class "title" ]
+ [ text (Translations.getMessage radioName translations) ]
+ , div
+ [ class "radioElems" ]
+ (List.map (radioInput translations field htmlMap) fieldNames)
, case field.liveError of
Just error -> formError translations error
Nothing -> text ""
]
+radioInput : Translations -> FieldState String String -> (Html Form.Msg -> Html msg) -> String -> Html msg
+radioInput translations field htmlMap fieldName =
+ label
+ [ for fieldName ]
+ [ htmlMap <|
+ Input.radioInput
+ field.path
+ field
+ [ id fieldName
+ , value fieldName
+ , checked (field.value == Just fieldName)
+ ]
+ , text (Translations.getMessage fieldName translations)
+ ]
+
formError : Translations -> FormError.Error String -> Html msg
formError translations error =
let errorElement error params =
diff --git a/src/server/Design/Form.hs b/src/server/Design/Form.hs
index 2ad6a9c..4bd1ad6 100644
--- a/src/server/Design/Form.hs
+++ b/src/server/Design/Form.hs
@@ -19,7 +19,7 @@ design = do
".textInput" ? do
position relative
- marginBottom (em 1)
+ marginBottom (em 1.5)
paddingTop (px inputTop)
marginTop (px (-10))
@@ -57,3 +57,23 @@ design = do
position absolute
color Color.chestnutRose
fontSize (pct 80)
+
+ ".radioGroup" ? do
+ position relative
+ marginBottom (em 2)
+
+ ".title" ? do
+ color Color.silver
+ marginBottom (em 0.8)
+
+ ".radioElems" ? do
+ display flex
+ "justify-content" -: "space-around"
+
+ label ? do
+ marginBottom (px 5)
+ display block
+ cursor pointer
+ input ? do
+ margin (px 0) (px 8) (px (-1)) (px 0)
+ cursor pointer
diff --git a/src/server/Design/LoggedIn/Home/Search.hs b/src/server/Design/LoggedIn/Home/Search.hs
index 1bc91ef..726b4cf 100644
--- a/src/server/Design/LoggedIn/Home/Search.hs
+++ b/src/server/Design/LoggedIn/Home/Search.hs
@@ -8,6 +8,10 @@ import Clay
import Design.Constants
+import qualified Design.Helper as Helper
+import qualified Design.Color as Color
+import qualified Design.Constants as Constants
+
design :: Css
design = do
marginBottom blockMarginBottom
@@ -17,3 +21,11 @@ design = do
".textInput" ? do
display inlineBlock
marginRight (px 30)
+ marginBottom (px 0)
+
+ ".stat" ? do
+ lineHeight (pct 100)
+
+ ".addPayment" ? do
+ Helper.defaultButton Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
+ float floatRight
diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs
index b68f48f..538bc6d 100644
--- a/src/server/Design/LoggedIn/Home/Table.hs
+++ b/src/server/Design/LoggedIn/Home/Table.hs
@@ -33,32 +33,20 @@ design = do
".row" ? do
fontSize (px 18)
height (px rowHeightPx)
+ ".cell:first-child::before" ? do
+ display block
+ content (stringContent "")
+ position absolute
+ top (px 0)
+ left (px 0)
+ width (px 0)
+ height (px rowHeightPx)
+ backgroundColor Color.mossGreen
+ transition "width" (sec 0.3) ease (sec 0)
+ opacity (0.8)
hover & do
- let (borderW, triangleW, triangleH) = (4, 6, 8)
- ".cell:first-child::before" ? do
- display block
- content (stringContent "")
- position absolute
- top (px 0)
- left (px 0)
-
- width (px borderW)
- height (px rowHeightPx)
- backgroundColor Color.mossGreen
-
- ".cell:first-child::after" ? do
- display block
- content (stringContent "")
- position absolute
- top (px (rowHeightPx `Prelude.div` 2 - triangleH))
- left (px borderW)
-
- width (px 0)
- height (px 0)
- borderTop solid (px triangleH) transparent
- borderBottom solid (px triangleH) transparent
- borderLeft solid (px triangleW) Color.mossGreen
+ ".cell:first-child::before" ? width (px 5)
nthChild "odd" & do
backgroundColor Color.wildSand
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 1653ea7..c87a2c1 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -54,10 +54,15 @@ data Key =
-- Payments
- | Add
+ | Name
+ | Cost
+ | Frequency
+ | InvalidFrequency
+ | AddPayment
| PaymentNotDeleted
| Punctual
| Monthly
+
| SingularMonthlyCount
| PluralMonthlyCount
| PaymentsTitle
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 8a640d1..f4087a4 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -200,10 +200,30 @@ m l CostRequired =
-- Payments
-m l Add =
+m l Name =
case l of
- English -> "Add"
- French -> "Ajouter"
+ English -> "Name"
+ French -> "Nom"
+
+m l Cost =
+ case l of
+ English -> "Cost"
+ French -> "Coût"
+
+m l Frequency =
+ case l of
+ English -> "Frequency"
+ French -> "Fréquence"
+
+m l InvalidFrequency =
+ case l of
+ English -> "Invalid frequency"
+ French -> "Fréquence invalide"
+
+m l AddPayment =
+ case l of
+ English -> "Add a payment"
+ French -> "Ajouter un paiement"
m l PaymentNotDeleted =
case l of
@@ -213,12 +233,12 @@ m l PaymentNotDeleted =
m l Punctual =
case l of
English -> "Punctual"
- French -> "Ponctuel"
+ French -> "Ponctuelle"
m l Monthly =
case l of
English -> "Monthly"
- French -> "Mensuel"
+ French -> "Mensuelle"
m l SingularMonthlyCount =
case l of
@@ -227,7 +247,7 @@ m l SingularMonthlyCount =
m l PluralMonthlyCount =
case l of
- English -> "{1} monthly payments totalling {2}"
+ English -> "{1} monthly payments worth {2}"
French -> "{1} paiements mensuels comptabilisant {2}"
m l PaymentsTitle =
@@ -253,7 +273,7 @@ m l SearchText =
m l Worth =
case l of
English -> "{1} worth {2}"
- French -> "{1} valant {2}"
+ French -> "{1} comptabilisant {2}"
-- Statistics
@@ -348,13 +368,13 @@ m l InvalidInt =
m l SmallerIntThan =
case l of
- English -> "Integer bigger than {1} required"
- French -> "Entier supérieur à {1} requis"
+ English -> "Integer bigger than {1} or equal required"
+ French -> "Entier supérieur ou égal à {1} requis"
m l GreaterIntThan =
case l of
- English -> "Integer smaller than {1} required"
- French -> "Entier inférieur à {1} requis"
+ English -> "Integer smaller than {1} or equal required"
+ French -> "Entier inférieur ou égal à {1} requis"
-- Dialog