diff options
Diffstat (limited to 'client/src/View/Payment')
| -rw-r--r-- | client/src/View/Payment/Add.hs | 1 | ||||
| -rw-r--r-- | client/src/View/Payment/Clone.hs | 1 | ||||
| -rw-r--r-- | client/src/View/Payment/Edit.hs | 1 | ||||
| -rw-r--r-- | client/src/View/Payment/Form.hs | 19 | ||||
| -rw-r--r-- | client/src/View/Payment/Table.hs | 13 |
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 |