Make payment edition to work on the frontend

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