aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View/Payment')
-rw-r--r--client/src/View/Payment/Add.hs1
-rw-r--r--client/src/View/Payment/Clone.hs1
-rw-r--r--client/src/View/Payment/Edit.hs1
-rw-r--r--client/src/View/Payment/Form.hs19
-rw-r--r--client/src/View/Payment/Table.hs13
5 files changed, 25 insertions, 10 deletions
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 88806bc..e83dba9 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -46,6 +46,7 @@ view input cancel = do
, Form._input_category = -1
, Form._input_frequency = frequency
, Form._input_mkPayload = CreatePayment
+ , Form._input_httpMethod = Form.Post
}
hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 5624f6c..922e89c 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -49,6 +49,7 @@ view input cancel = do
, Form._input_category = category
, Form._input_frequency = _payment_frequency payment
, Form._input_mkPayload = CreatePayment
+ , Form._input_httpMethod = Form.Post
}
hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Edit.hs b/client/src/View/Payment/Edit.hs
index 5020e57..9c11af0 100644
--- a/client/src/View/Payment/Edit.hs
+++ b/client/src/View/Payment/Edit.hs
@@ -44,6 +44,7 @@ view input cancel = do
, Form._input_category = category
, Form._input_frequency = _payment_frequency payment
, Form._input_mkPayload = EditPayment (_payment_id payment)
+ , Form._input_httpMethod = Form.Put
}
hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index ba54957..9889638 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -1,6 +1,7 @@
module View.Payment.Form
( view
, Input(..)
+ , HttpMethod(..)
, Output(..)
) where
@@ -46,8 +47,11 @@ data Input t p = Input
, _input_category :: CategoryId
, _input_frequency :: Frequency
, _input_mkPayload :: Text -> Int -> Day -> CategoryId -> Frequency -> p
+ , _input_httpMethod :: HttpMethod
}
+data HttpMethod = Put | Post
+
data Output t = Output
{ _output_hide :: Event t ()
, _output_addPayment :: Event t SavedPayment
@@ -139,7 +143,7 @@ view input = do
})
(addPayment, waiting) <- WaitFor.waitFor
- (Ajax.postJson "/payment")
+ (ajax "/payment")
(ValidationUtil.fireValidation payment confirm)
return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, confirm)
@@ -150,14 +154,19 @@ view input = do
}
where
- frequencies = M.fromList
- [ (Punctual, Msg.get Msg.Payment_PunctualMale)
- , (Monthly, Msg.get Msg.Payment_MonthlyMale)
- ]
+ frequencies =
+ M.fromList
+ [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+ , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+ ]
categories = M.fromList . flip map (_input_categories input) $ \c ->
(_category_id c, _category_name c)
+ ajax =
+ case _input_httpMethod input of
+ Post -> Ajax.postJson
+ Put -> Ajax.putJson
findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
findCategory paymentName =
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index f2b8870..40bc864 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -44,6 +44,7 @@ data TableIn t = TableIn
data TableOut t = TableOut
{ _tableOut_addPayment :: Event t SavedPayment
+ , _tableOut_editPayment :: Event t SavedPayment
, _tableOut_deletePayment :: Event t Payment
}
@@ -51,7 +52,7 @@ widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
widget tableIn = do
R.divClass "table" $ do
- (addPayment, deletePayment) <- R.divClass "lines" $ do
+ (addPayment, editPayment, deletePayment) <- R.divClass "lines" $ do
R.divClass "header" $ do
R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
R.divClass "cell cost" $ R.text $ Msg.get Msg.Payment_Cost
@@ -66,8 +67,9 @@ widget tableIn = do
(R.simpleList paymentRange (paymentRow init paymentCategories))
return $
- ( R.switch . R.current . fmap (R.leftmost . map fst) $ result
- , R.switch . R.current . fmap (R.leftmost . map snd) $ result
+ ( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
+ , R.switch . R.current . fmap (R.leftmost . map (\(_, b, _) -> b)) $ result
+ , R.switch . R.current . fmap (R.leftmost . map (\(_, _, c) -> c)) $ result
)
ReflexUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
@@ -75,6 +77,7 @@ widget tableIn = do
return $ TableOut
{ _tableOut_addPayment = addPayment
+ , _tableOut_editPayment = editPayment
, _tableOut_deletePayment = deletePayment
}
@@ -98,7 +101,7 @@ paymentRow
=> Init
-> Dynamic t [PaymentCategory]
-> Dynamic t Payment
- -> m (Event t SavedPayment, Event t Payment)
+ -> m (Event t SavedPayment, Event t SavedPayment, Event t Payment)
paymentRow init paymentCategories payment =
R.divClass "row" $ do
@@ -200,7 +203,7 @@ paymentRow init paymentCategories payment =
}
}
- return $ (paymentCloned, paymentDeleted)
+ return $ (paymentCloned, paymentEdited, paymentDeleted)
findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
findCategory categories paymentCategories paymentName = do