Add payment clone

22 files changed, 636 insertions, 334 deletions

diff --git a/README.md b/README.md
index 19309f5..bc9e98c 100644
--- a/README.md
+++ b/README.md
@@ -58,12 +58,16 @@ See [application.conf](application.conf).
 
 ## TODO
 
+### Fix
+
+- When clicking on an input label, focus to the input
+
 ### Payment view
 
 - Edit a payment
-- Possibly remove payment category after payment edit
-- Clone a payment
-- Add icon tooltip
+- Possibly remove payment category after payment edit (frontend)
+- Remove old validation, use client validation on the backend
+- Add icon tooltip ?
 
 ### Income view
 
@@ -88,6 +92,7 @@ See [application.conf](application.conf).
 
 ### Code
 
+- remove client warning messages
 - Use BEM style
 - Move the CSS out from the index page
 - Add tests about exceedingPayers
@@ -101,3 +106,5 @@ See [application.conf](application.conf).
 
 - deploy command
 - migration diff (use flyway?).
+- utiliser ghcid
+- set up fast deploy
diff --git a/client/client.cabal b/client/client.cabal
index ce3c059..5fc20ae 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -44,16 +44,19 @@ Executable client
     Component.Select
     Icon
     Util.Ajax
-    Util.Dom
     Util.Either
     Util.List
+    Util.Reflex
     Util.Validation
     Util.WaitFor
     View.App
     View.Header
     View.Payment
     View.Payment.Add
+    View.Payment.Clone
     View.Payment.Delete
+    View.Payment.Edit
+    View.Payment.Form
     View.Payment.Header
     View.Payment.Pages
     View.Payment.Table
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index fac417e..96c2679 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -1,7 +1,7 @@
 module Component.Modal
-  ( ModalIn(..)
-  , ModalOut(..)
-  , modal
+  ( Input(..)
+  , Content
+  , view
   ) where
 
 import           Control.Monad     (void)
@@ -17,29 +17,26 @@ import           Reflex.Dom        (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom        as R
 import qualified Reflex.Dom.Class  as R
 
-import qualified Util.Dom          as Dom
+import qualified Util.Reflex       as ReflexUtil
 
-data ModalIn t m a = ModalIn
-  { _modalIn_show    :: Event t ()
-  , _modalIn_hide    :: Event t ()
-  , _modalIn_content :: m a
-  }
+-- Content = CurtainClickEvent -> (CancelEvent, ConfirmEvent)
+type Content t m a = Event t () -> m (Event t (), Event t a)
 
-data ModalOut t a = ModalOut
-  { _modalOut_content :: a
-  , _modalOut_hide    :: Event t ()
+data Input t m a = Input
+  { _input_show    :: Event t ()
+  , _input_content :: Content t m a
   }
 
-modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut t a)
-modal modalIn = do
+view :: forall t m a. MonadWidget t m => Input t m a -> m (Event t a)
+view input = do
   rec
-    let show = Show <$ (_modalIn_show modalIn)
+    let show = Show <$ (_input_show input)
 
         startHiding =
           R.attachWithMaybe
             (\a _ -> if a then Just StartHiding else Nothing)
             (R.current canBeHidden)
-            (R.leftmost [ _modalIn_hide modalIn, curtainClick ])
+            (R.leftmost [ hide, curtainClick ])
 
     canBeHidden <-
       R.holdDyn True $ R.leftmost
@@ -56,18 +53,25 @@ modal modalIn = do
     modalClass <-
       R.holdDyn "" (fmap getModalClass action)
 
-    (elem, (curtainClick, content)) <-
-      R.buildElement "div" (fmap getAttributes modalClass) $ do
-        (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
-        content <- R.divClass "g-Modal__Content" $ _modalIn_content modalIn
-        return (R.domEvent R.Click curtain, content)
+    (elem, dyn) <-
+      R.buildElement "div" (getAttributes <$> modalClass) $
+        ReflexUtil.visibleIfEvent
+          (isVisible <$> action)
+          (R.blank >> return (R.never, R.never, R.never))
+          (do
+            (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
+            let curtainClick = R.domEvent R.Click curtain
+            (hide, content) <- R.divClass "g-Modal__Content" (_input_content input curtainClick)
+            return (curtainClick, hide, content))
+
 
-  performShowEffects action elem
+    performShowEffects action elem
 
-  return $ ModalOut
-    { _modalOut_content = content
-    , _modalOut_hide = curtainClick
-    }
+    let curtainClick = R.switchDyn $ (\(a, _, _) -> a) <$> dyn
+    let hide = R.switchDyn $ (\(_, b, _) -> b) <$> dyn
+    let content = R.switchDyn $ (\(_, _, c) -> c) <$> dyn
+
+  return content
 
 getAttributes :: Text -> LM.Map Text Text
 getAttributes modalClass =
@@ -80,7 +84,7 @@ performShowEffects
   -> Element.Element
   -> m ()
 performShowEffects showEvent elem = do
-  body <- Dom.getBody
+  body <- ReflexUtil.getBody
 
   let showEffects =
         flip fmap showEvent (\case
@@ -105,3 +109,8 @@ getModalClass :: Action -> Text
 getModalClass Show        = "g-Modal--Show"
 getModalClass StartHiding = "g-Modal--Hiding"
 getModalClass _           = ""
+
+isVisible :: Action -> Bool
+isVisible Show        = True
+isVisible StartHiding = True
+isVisible EndHiding   = False
diff --git a/client/src/Util/Dom.hs b/client/src/Util/Reflex.hs
index 55b8521..c14feeb 100644
--- a/client/src/Util/Dom.hs
+++ b/client/src/Util/Reflex.hs
@@ -1,8 +1,9 @@
-module Util.Dom
-  ( divIfDyn
-  , divIfEvent
+module Util.Reflex
+  ( visibleIfDyn
+  , visibleIfEvent
   , divVisibleIf
   , divClassVisibleIf
+  , flatten
   , getBody
   ) where
 
@@ -15,17 +16,18 @@ import           GHCJS.DOM.Types          (Element)
 import           Reflex.Dom               (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom               as R
 
-divIfDyn :: forall t m a. MonadWidget t m => Dynamic t Bool -> m a -> m a -> m (Dynamic t a)
-divIfDyn cond = divIfEvent (R.updated cond)
+visibleIfDyn :: forall t m a. MonadWidget t m => Dynamic t Bool -> m a -> m a -> m (Event t a)
+visibleIfDyn cond empty content =
+  R.dyn $ R.ffor cond $ \case
+    True -> content
+    False -> empty
 
-divIfEvent :: forall t m a. MonadWidget t m => Event t Bool -> m a -> m a -> m (Dynamic t a)
-divIfEvent cond empty content =
-  R.widgetHold empty (flip fmap cond (\show ->
-    if show
-      then
-        content
-      else
-        empty))
+visibleIfEvent :: forall t m a. MonadWidget t m => Event t Bool -> m a -> m a -> m (Dynamic t a)
+visibleIfEvent cond empty content =
+  R.widgetHold empty $
+    R.ffor cond $ \case
+      True -> content
+      False -> empty
 
 divVisibleIf :: forall t m a. MonadWidget t m => Dynamic t Bool -> m a -> m a
 divVisibleIf cond content = divClassVisibleIf cond "" content
@@ -37,6 +39,11 @@ divClassVisibleIf cond className content =
     (fmap (\c -> (M.singleton "class" className) `M.union` if c then M.empty else M.singleton "style" "display:none") cond)
     content
 
+flatten :: forall t m a. MonadWidget t m => Event t (Event t a) -> m (Event t a)
+flatten e = do
+  dyn <- R.holdDyn R.never e
+  return $ R.switchDyn dyn
+
 getBody :: forall t m. MonadWidget t m => m Element
 getBody = do
   document <- Dom.currentDocumentUnchecked
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index f363b06..ab83447 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -11,9 +11,9 @@ import           Prelude             hiding (init)
 import           Reflex.Dom          (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom          as R
 
-import           Common.Model        (CreatedPayment (..), Frequency, Init (..),
-                                      Payment (..), PaymentCategory (..),
-                                      PaymentId)
+import           Common.Model        (Frequency, Init (..), Payment (..),
+                                      PaymentCategory (..), PaymentId,
+                                      SavedPayment (..))
 import qualified Common.Util.Text    as T
 import           View.Payment.Header (HeaderIn (..), HeaderOut (..))
 import qualified View.Payment.Header as Header
@@ -36,15 +36,19 @@ widget paymentIn = do
     rec
       let init = _paymentIn_init paymentIn
           paymentsPerPage = 7
+          savedPayments = R.leftmost
+            [ _headerOut_addPayment header
+            , _tableOut_addPayment table
+            ]
 
       payments <- getPayments
         (_init_payments init)
-        (_createdPayment_payment <$> _headerOut_addPayment header)
+        (_savedPayment_payment <$> savedPayments)
         (_tableOut_deletePayment table)
 
       paymentCategories <- getPaymentCategories
         (_init_paymentCategories init)
-        (_createdPayment_paymentCategory <$> _headerOut_addPayment header)
+        (_savedPayment_paymentCategory <$> savedPayments)
         payments
         (_tableOut_deletePayment table)
 
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 69e29a7..88806bc 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -1,161 +1,54 @@
 module View.Payment.Add
   ( view
-  , AddIn(..)
-  , AddOut(..)
+  , Input(..)
   ) where
 
 import           Control.Monad             (join)
 import           Control.Monad.IO.Class    (liftIO)
-import qualified Data.List                 as L
-import qualified Data.Map                  as M
-import qualified Data.Maybe                as Maybe
-import           Data.Text                 (Text)
 import qualified Data.Text                 as T
-import qualified Data.Time.Calendar        as Calendar
 import qualified Data.Time.Clock           as Time
-import qualified Data.Validation           as V
-import           Reflex.Dom                (Dynamic, Event, MonadWidget, Reflex)
+import           Reflex.Dom                (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom                as R
-import qualified Text.Read                 as T
 
-import           Common.Model              (Category (..), CategoryId,
-                                            CreatePayment (..),
-                                            CreatedPayment (..), Frequency (..),
-                                            Payment (..), PaymentCategory (..))
+import           Common.Model              (Category (..), CreatePayment (..),
+                                            Frequency (..), Payment (..),
+                                            PaymentCategory (..),
+                                            SavedPayment (..))
 import qualified Common.Msg                as Msg
-import qualified Common.Util.Time          as Time
+import qualified Common.Util.Time          as TimeUtil
 import qualified Common.Validation.Payment as PaymentValidation
-import           Component                 (ButtonIn (..), InputIn (..),
-                                            InputOut (..), SelectIn (..),
-                                            SelectOut (..))
-import qualified Component                 as Component
-import qualified Util.Ajax                 as Ajax
-import qualified Util.Either               as EitherUtil
-import qualified Util.Validation           as ValidationUtil
-import qualified Util.WaitFor              as WaitFor
-
-data AddIn t = AddIn
-  { _addIn_categories        :: [Category]
-  , _addIn_paymentCategories :: Dynamic t [PaymentCategory]
-  , _addIn_frequency         :: Dynamic t Frequency
-  , _addIn_cancel            :: Event t ()
-  }
-
-data AddOut t = AddOut
-  { _addOut_cancel             :: Event t ()
-  , _addOut_addPayment         :: Event t CreatedPayment
-  , _addOut_addPaymentCategory :: Event t PaymentCategory
+import qualified Component.Modal           as Modal
+import qualified Util.Reflex               as ReflexUtil
+import qualified View.Payment.Form         as Form
+
+data Input t = Input
+  { _input_categories        :: [Category]
+  , _input_paymentCategories :: Dynamic t [PaymentCategory]
+  , _input_frequency         :: Dynamic t Frequency
   }
 
-view :: forall t m. MonadWidget t m => AddIn t -> m (AddOut t)
-view addIn = do
-  R.divClass "add" $ do
-    R.divClass "addHeader" $ R.text $ Msg.get Msg.Payment_Add
-
-    R.divClass "addContent" $ do
-      rec
-        let reset = R.leftmost
-              [ "" <$ cancel
-              , "" <$ addPayment
-              , "" <$ _addIn_cancel addIn
-              ]
-
-        name <- Component.input
-          (Component.defaultInputIn
-            { _inputIn_label = Msg.get Msg.Payment_Name
-            , _inputIn_validation = PaymentValidation.name
-            })
-          reset
-          confirm
-
-        cost <- _inputOut_value <$> (Component.input
-          (Component.defaultInputIn
-            { _inputIn_label = Msg.get Msg.Payment_Cost
-            , _inputIn_validation = PaymentValidation.cost
-            })
-          reset
-          confirm)
-
-        now <- liftIO Time.getCurrentTime
-
-        currentDay <- do
-          d <- liftIO $ Time.timeToDay now
-          return . T.pack . Calendar.showGregorian $ d
-
-        date <- _inputOut_value <$> (Component.input
-          (Component.defaultInputIn
-            { _inputIn_label = Msg.get Msg.Payment_Date
-            , _inputIn_initialValue = currentDay
-            , _inputIn_inputType = "date"
-            , _inputIn_hasResetButton = False
-            , _inputIn_validation = PaymentValidation.date
-            })
-          (currentDay <$ reset)
-          confirm)
-
-        let setCategory =
-              R.fmapMaybe id
-                . R.updated
-                $ findCategory <$> (_inputOut_raw name) <*> (_addIn_paymentCategories addIn)
-
-        category <- _selectOut_value <$> (Component.select $ SelectIn
-          { _selectIn_label = Msg.get Msg.Payment_Category
-          , _selectIn_initialValue = -1
-          , _selectIn_value = setCategory
-          , _selectIn_values = R.constDyn categories
-          , _selectIn_reset = reset
-          , _selectIn_isValid = \id -> id /= -1
-          , _selectIn_validate = confirm
-          })
-
-        let payment = do
-              n <- _inputOut_value name
-              c <- cost
-              d <- date
-              cat <- category
-              f <- _addIn_frequency addIn
-              return (CreatePayment
-                <$> ValidationUtil.nelError n
-                <*> ValidationUtil.nelError c
-                <*> ValidationUtil.nelError d
-                <*> ValidationUtil.nelError cat
-                <*> V.Success f)
-
-        (addPayment, cancel, confirm) <- R.divClass "buttons" $ do
-          rec
-            cancel <- Component._buttonOut_clic <$> (Component.button $
-              (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
-                { _buttonIn_class = R.constDyn "undo" })
-
-            confirm <- Component._buttonOut_clic <$> (Component.button $
-              (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
-                { _buttonIn_class = R.constDyn "confirm"
-                , _buttonIn_waiting = waiting
-                , _buttonIn_submit = True
-                })
-
-            (addPayment, waiting) <- WaitFor.waitFor
-              (Ajax.postJson "/payment")
-              (ValidationUtil.fireValidation payment confirm)
-
-          return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, confirm)
-
-      return AddOut
-        { _addOut_cancel = cancel
-        , _addOut_addPayment = addPayment
-        }
-
-  where
-    frequencies = M.fromList
-      [ (Punctual, Msg.get Msg.Payment_PunctualMale)
-      , (Monthly, Msg.get Msg.Payment_MonthlyMale)
-      ]
-
-    categories = M.fromList . flip map (_addIn_categories addIn) $ \c ->
-      (_category_id c, _category_name c)
-
-
-findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
-findCategory paymentName =
-  fmap _paymentCategory_category
-    . L.find ((==) (T.toLower paymentName) . _paymentCategory_name)
+view :: forall t m. MonadWidget t m => Input t -> Modal.Content t m SavedPayment
+view input cancel = do
+
+  currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
+
+  formOutput <- R.dyn $ do
+    paymentCategories <- _input_paymentCategories input
+    frequency <- _input_frequency input
+    return $ Form.view $ Form.Input
+      { Form._input_cancel = cancel
+      , Form._input_headerLabel = Msg.get Msg.Payment_Add
+      , Form._input_categories = _input_categories input
+      , Form._input_paymentCategories = paymentCategories
+      , Form._input_name = ""
+      , Form._input_cost = ""
+      , Form._input_date = currentDay
+      , Form._input_category = -1
+      , Form._input_frequency = frequency
+      , Form._input_mkPayload = CreatePayment
+      }
+
+  hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
+  addPayment <- ReflexUtil.flatten (Form._output_addPayment <$> formOutput)
+
+  return (hide, addPayment)
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
new file mode 100644
index 0000000..5624f6c
--- /dev/null
+++ b/client/src/View/Payment/Clone.hs
@@ -0,0 +1,60 @@
+module View.Payment.Clone
+  ( Input(..)
+  , view
+  ) where
+
+import qualified Control.Monad             as Monad
+import           Control.Monad.IO.Class    (liftIO)
+import qualified Data.Text                 as T
+import qualified Data.Time.Clock           as Time
+import           Reflex.Dom                (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom                as R
+
+import           Common.Model              (Category (..), CategoryId,
+                                            CreatePayment (..), Frequency (..),
+                                            Payment (..), PaymentCategory (..),
+                                            SavedPayment (..))
+import qualified Common.Msg                as Msg
+import qualified Common.Util.Time          as TimeUtil
+import qualified Common.Validation.Payment as PaymentValidation
+import qualified Component.Modal           as Modal
+import qualified Util.Reflex               as ReflexUtil
+import qualified View.Payment.Form         as Form
+
+data Input t = Input
+  { _input_show              :: Event t ()
+  , _input_categories        :: [Category]
+  , _input_paymentCategories :: Dynamic t [PaymentCategory]
+  , _input_payment           :: Dynamic t Payment
+  , _input_category          :: Dynamic t CategoryId
+  }
+
+view :: forall t m. MonadWidget t m => Input t -> Modal.Content t m SavedPayment
+view input cancel = do
+
+  currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
+
+  formOutput <- R.dyn $ do
+    paymentCategories <- _input_paymentCategories input
+    payment <- _input_payment input
+    category <- _input_category input
+    return . Form.view $ Form.Input
+      { Form._input_cancel = cancel
+      , Form._input_headerLabel = Msg.get Msg.Payment_CloneLong
+      , Form._input_categories = _input_categories input
+      , Form._input_paymentCategories = paymentCategories
+      , Form._input_name = _payment_name payment
+      , Form._input_cost = T.pack . show . _payment_cost $ payment
+      , Form._input_date = currentDay
+      , Form._input_category = category
+      , Form._input_frequency = _payment_frequency payment
+      , Form._input_mkPayload = CreatePayment
+      }
+
+  hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
+  clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> formOutput)
+
+  return $
+    ( hide
+    , clonePayment
+    )
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 65ce660..e7e319e 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -1,39 +1,34 @@
 module View.Payment.Delete
-  ( view
-  , DeleteIn(..)
-  , DeleteOut(..)
+  ( Input(..)
+  , view
   ) where
 
-import           Data.Text    (Text)
-import qualified Data.Text    as T
-import           Reflex.Dom   (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom   as R
-
-import           Common.Model (Payment (..))
-import qualified Common.Msg   as Msg
-import           Component    (ButtonIn (..), ButtonOut (..))
-import qualified Component    as Component
-import qualified Util.Ajax    as Ajax
-import qualified Util.Either  as EitherUtil
-import qualified Util.WaitFor as WaitFor
-
-data DeleteIn t = DeleteIn
-  { _deleteIn_payment :: Dynamic t Payment
-  }
-
-data DeleteOut t = DeleteOut
-  { _deleteOut_cancel   :: Event t ()
-  , _deleteOut_validate :: Event t Payment
+import           Data.Text       (Text)
+import qualified Data.Text       as T
+import           Reflex.Dom      (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom      as R
+
+import           Common.Model    (Payment (..))
+import qualified Common.Msg      as Msg
+import           Component       (ButtonIn (..), ButtonOut (..))
+import qualified Component       as Component
+import qualified Component.Modal as Modal
+import qualified Util.Ajax       as Ajax
+import qualified Util.Either     as EitherUtil
+import qualified Util.WaitFor    as WaitFor
+
+data Input t = Input
+  { _input_payment :: Dynamic t Payment
   }
 
-view :: forall t m. MonadWidget t m => (DeleteIn t) -> m (DeleteOut t)
-view deleteIn =
+view :: forall t m. MonadWidget t m => (Input t) -> Modal.Content t m Payment
+view input _ =
   R.divClass "delete" $ do
     R.divClass "deleteHeader" $ R.text $ Msg.get Msg.Payment_DeleteConfirm
 
     R.divClass "deleteContent" $ do
 
-      (deletedPayment, cancel) <- R.divClass "buttons" $ do
+      (confirm, cancel) <- R.divClass "buttons" $ do
 
         cancel <- Component._buttonOut_clic <$> (Component.button $
           (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
@@ -48,7 +43,7 @@ view deleteIn =
               })
 
           let url =
-                R.ffor (_deleteIn_payment deleteIn) (\id ->
+                R.ffor (_input_payment input) (\id ->
                   T.concat ["/payment/", T.pack . show $ _payment_id id]
                 )
 
@@ -58,7 +53,7 @@ view deleteIn =
 
         return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
 
-      return DeleteOut
-        { _deleteOut_cancel = cancel
-        , _deleteOut_validate = R.tag (R.current $ _deleteIn_payment deleteIn) deletedPayment
-        }
+      return $
+        ( R.leftmost [ cancel, () <$ confirm ]
+        , R.tag (R.current $ _input_payment input) confirm
+        )
diff --git a/client/src/View/Payment/Edit.hs b/client/src/View/Payment/Edit.hs
new file mode 100644
index 0000000..5020e57
--- /dev/null
+++ b/client/src/View/Payment/Edit.hs
@@ -0,0 +1,55 @@
+module View.Payment.Edit
+  ( Input(..)
+  , view
+  ) where
+
+import qualified Control.Monad             as Monad
+import qualified Data.Text                 as T
+import           Reflex.Dom                (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom                as R
+
+import           Common.Model              (Category (..), CategoryId,
+                                            EditPayment (..), Frequency (..),
+                                            Payment (..), PaymentCategory (..),
+                                            SavedPayment (..))
+import qualified Common.Msg                as Msg
+import qualified Common.Validation.Payment as PaymentValidation
+import qualified Component.Modal           as Modal
+import qualified Util.Reflex               as ReflexUtil
+import qualified View.Payment.Form         as Form
+
+data Input t = Input
+  { _input_show              :: Event t ()
+  , _input_categories        :: [Category]
+  , _input_paymentCategories :: Dynamic t [PaymentCategory]
+  , _input_payment           :: Dynamic t Payment
+  , _input_category          :: Dynamic t CategoryId
+  }
+
+view :: forall t m. MonadWidget t m => Input t -> Modal.Content t m SavedPayment
+view input cancel = do
+
+  formOutput <- R.dyn $ do
+    paymentCategories <- _input_paymentCategories input
+    payment <- _input_payment input
+    category <- _input_category input
+    return . Form.view $ Form.Input
+      { Form._input_cancel = cancel
+      , Form._input_headerLabel = Msg.get Msg.Payment_EditLong
+      , Form._input_categories = _input_categories input
+      , Form._input_paymentCategories = paymentCategories
+      , Form._input_name = _payment_name payment
+      , Form._input_cost = T.pack . show . _payment_cost $ payment
+      , Form._input_date = _payment_date payment
+      , Form._input_category = category
+      , Form._input_frequency = _payment_frequency payment
+      , Form._input_mkPayload = EditPayment (_payment_id payment)
+      }
+
+  hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
+  editPayment <- ReflexUtil.flatten (Form._output_addPayment <$> formOutput)
+
+  return $
+    ( hide
+    , editPayment
+    )
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
new file mode 100644
index 0000000..ba54957
--- /dev/null
+++ b/client/src/View/Payment/Form.hs
@@ -0,0 +1,165 @@
+module View.Payment.Form
+  ( view
+  , Input(..)
+  , Output(..)
+  ) where
+
+import           Control.Monad             (join)
+import           Control.Monad.IO.Class    (liftIO)
+import           Data.Aeson                (ToJSON)
+import qualified Data.List                 as L
+import qualified Data.Map                  as M
+import qualified Data.Maybe                as Maybe
+import           Data.Text                 (Text)
+import qualified Data.Text                 as T
+import           Data.Time.Calendar        (Day)
+import qualified Data.Time.Calendar        as Calendar
+import qualified Data.Validation           as V
+import           Reflex.Dom                (Dynamic, Event, MonadHold,
+                                            MonadWidget, Reflex)
+import qualified Reflex.Dom                as R
+import qualified Text.Read                 as T
+
+import           Common.Model              (Category (..), CategoryId,
+                                            Frequency (..), Payment (..),
+                                            PaymentCategory (..),
+                                            SavedPayment (..))
+import qualified Common.Msg                as Msg
+import qualified Common.Validation.Payment as PaymentValidation
+import           Component                 (ButtonIn (..), InputIn (..),
+                                            InputOut (..), SelectIn (..),
+                                            SelectOut (..))
+import qualified Component                 as Component
+import qualified Util.Ajax                 as Ajax
+import qualified Util.Either               as EitherUtil
+import qualified Util.Validation           as ValidationUtil
+import qualified Util.WaitFor              as WaitFor
+
+data Input t p = Input
+  { _input_cancel            :: Event t ()
+  , _input_headerLabel       :: Text
+  , _input_categories        :: [Category]
+  , _input_paymentCategories :: [PaymentCategory]
+  , _input_name              :: Text
+  , _input_cost              :: Text
+  , _input_date              :: Day
+  , _input_category          :: CategoryId
+  , _input_frequency         :: Frequency
+  , _input_mkPayload         :: Text -> Int -> Day -> CategoryId -> Frequency -> p
+  }
+
+data Output t = Output
+  { _output_hide       :: Event t ()
+  , _output_addPayment :: Event t SavedPayment
+  }
+
+view :: forall t m p. (MonadWidget t m, ToJSON p) => Input t p -> m (Output t)
+view input = do
+  R.divClass "form" $ do
+    R.divClass "formHeader" $
+      R.text (_input_headerLabel input)
+
+    R.divClass "formContent" $ do
+      rec
+        let reset = R.leftmost
+              [ "" <$ cancel
+              , "" <$ addPayment
+              , "" <$ _input_cancel input
+              ]
+
+        name <- Component.input
+          (Component.defaultInputIn
+            { _inputIn_label = Msg.get Msg.Payment_Name
+            , _inputIn_initialValue = _input_name input
+            , _inputIn_validation = PaymentValidation.name
+            })
+          (_input_name input <$ reset)
+          confirm
+
+        cost <- _inputOut_value <$> (Component.input
+          (Component.defaultInputIn
+            { _inputIn_label = Msg.get Msg.Payment_Cost
+            , _inputIn_initialValue = _input_cost input
+            , _inputIn_validation = PaymentValidation.cost
+            })
+          (_input_cost input <$ reset)
+          confirm)
+
+        let initialDate = T.pack . Calendar.showGregorian . _input_date $ input
+
+        date <- _inputOut_value <$> (Component.input
+          (Component.defaultInputIn
+            { _inputIn_label = Msg.get Msg.Payment_Date
+            , _inputIn_initialValue = initialDate
+            , _inputIn_inputType = "date"
+            , _inputIn_hasResetButton = False
+            , _inputIn_validation = PaymentValidation.date
+            })
+          (initialDate <$ reset)
+          confirm)
+
+        let setCategory =
+              R.fmapMaybe id . R.updated $
+                R.ffor (_inputOut_raw name) $ \name ->
+                  findCategory name (_input_paymentCategories input)
+
+        category <- _selectOut_value <$> (Component.select $ SelectIn
+          { _selectIn_label = Msg.get Msg.Payment_Category
+          , _selectIn_initialValue = _input_category input
+          , _selectIn_value = setCategory
+          , _selectIn_values = R.constDyn categories
+          , _selectIn_reset = _input_category input <$ reset
+          , _selectIn_isValid = (/= -1)
+          , _selectIn_validate = confirm
+          })
+
+        let payment = do
+              n <- _inputOut_value name
+              c <- cost
+              d <- date
+              cat <- category
+              return ((_input_mkPayload input)
+                <$> ValidationUtil.nelError n
+                <*> ValidationUtil.nelError c
+                <*> ValidationUtil.nelError d
+                <*> ValidationUtil.nelError cat
+                <*> V.Success (_input_frequency input))
+
+        (addPayment, cancel, confirm) <- R.divClass "buttons" $ do
+          rec
+            cancel <- Component._buttonOut_clic <$> (Component.button $
+              (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+                { _buttonIn_class = R.constDyn "undo" })
+
+            confirm <- Component._buttonOut_clic <$> (Component.button $
+              (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
+                { _buttonIn_class = R.constDyn "confirm"
+                , _buttonIn_waiting = waiting
+                , _buttonIn_submit = True
+                })
+
+            (addPayment, waiting) <- WaitFor.waitFor
+              (Ajax.postJson "/payment")
+              (ValidationUtil.fireValidation payment confirm)
+
+          return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, confirm)
+
+      return Output
+        { _output_hide = R.leftmost [ cancel, () <$ addPayment ]
+        , _output_addPayment = addPayment
+        }
+
+  where
+    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)
+
+
+findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
+findCategory paymentName =
+  fmap _paymentCategory_category
+    . L.find ((==) (T.toLower paymentName) . _paymentCategory_name)
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 1bdee8d..7281195 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -17,10 +17,10 @@ import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Category, CreatedPayment (..),
-                                         Currency, ExceedingPayer (..),
-                                         Frequency (..), Income (..), Init (..),
-                                         Payment (..), PaymentCategory,
+import           Common.Model           (Category, Currency,
+                                         ExceedingPayer (..), Frequency (..),
+                                         Income (..), Init (..), Payment (..),
+                                         PaymentCategory, SavedPayment (..),
                                          User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
@@ -28,11 +28,10 @@ import qualified Common.View.Format     as Format
 
 import           Component              (ButtonIn (..), ButtonOut (..),
                                          InputIn (..), InputOut (..),
-                                         ModalIn (..), ModalOut (..),
                                          SelectIn (..), SelectOut (..))
 import qualified Component              as Component
+import qualified Component.Modal        as Modal
 import qualified Util.List              as L
-import           View.Payment.Add       (AddIn (..), AddOut (..))
 import qualified View.Payment.Add       as Add
 
 data HeaderIn t = HeaderIn
@@ -45,7 +44,7 @@ data HeaderIn t = HeaderIn
 data HeaderOut t = HeaderOut
   { _headerOut_searchName      :: Dynamic t Text
   , _headerOut_searchFrequency :: Dynamic t Frequency
-  , _headerOut_addPayment      :: Event t CreatedPayment
+  , _headerOut_addPayment      :: Event t SavedPayment
   }
 
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
@@ -90,7 +89,7 @@ payerAndAdd
   -> Dynamic t [PaymentCategory]
   -> Currency
   -> Dynamic t Frequency
-  -> m (Event t CreatedPayment)
+  -> m (Event t SavedPayment)
 payerAndAdd incomes payments users categories paymentCategories currency frequency = do
   time <- liftIO Time.getCurrentTime
   R.divClass "payerAndAdd" $ do
@@ -119,22 +118,14 @@ payerAndAdd incomes payments users categories paymentCategories currency frequen
       , _buttonIn_submit = False
       })
 
-    rec
-      modalOut <- Component.modal $ ModalIn
-        { _modalIn_show    = addPaymentClic
-        , _modalIn_hide = R.leftmost $
-            [ _addOut_cancel addOut
-            , fmap (const ()) . _addOut_addPayment $ addOut
-            ]
-        , _modalIn_content = Add.view $ AddIn
-            { _addIn_categories = categories
-            , _addIn_paymentCategories = paymentCategories
-            , _addIn_frequency = frequency
-            , _addIn_cancel = _modalOut_hide modalOut
-            }
-        }
-      let addOut = _modalOut_content modalOut
-    return (_addOut_addPayment addOut)
+    Modal.view $ Modal.Input
+      { Modal._input_show    = addPaymentClic
+      , Modal._input_content = Add.view $ Add.Input
+          { Add._input_categories = categories
+          , Add._input_paymentCategories = paymentCategories
+          , Add._input_frequency = frequency
+          }
+      }
 
 searchLine
   :: forall t m. MonadWidget t m
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index cbe7b50..9247143 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -4,15 +4,15 @@ module View.Payment.Pages
   , PagesOut(..)
   ) where
 
-import qualified Data.Text  as T
-import           Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.Text   as T
+import           Reflex.Dom  (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom  as R
 
-import           Component  (ButtonIn (..), ButtonOut (..))
-import qualified Component  as Component
+import           Component   (ButtonIn (..), ButtonOut (..))
+import qualified Component   as Component
 
 import qualified Icon
-import qualified Util.Dom   as Dom
+import qualified Util.Reflex as ReflexUtil
 
 data PagesIn t = PagesIn
   { _pagesIn_total   :: Dynamic t Int
@@ -26,7 +26,7 @@ data PagesOut t = PagesOut
 
 widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
 widget pagesIn = do
-  currentPage <- Dom.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
+  currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
 
   return $ PagesOut
     { _pagesOut_currentPage = currentPage
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index b09f30f..f2b8870 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -6,25 +6,32 @@ module View.Payment.Table
 
 import qualified Data.List           as L
 import qualified Data.Map            as M
+import qualified Data.Maybe          as Maybe
 import           Data.Text           (Text)
 import qualified Data.Text           as T
 import           Prelude             hiding (init)
 import           Reflex.Dom          (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom          as R
 
-import           Common.Model        (Category (..), Init (..), Payment (..),
-                                      PaymentCategory (..), User (..))
+import           Common.Model        (Category (..), Frequency (Punctual),
+                                      Init (..), Payment (..),
+                                      PaymentCategory (..), SavedPayment,
+                                      User (..))
 import qualified Common.Model        as CM
 import qualified Common.Msg          as Msg
 import qualified Common.View.Format  as Format
-import           Component           (ButtonIn (..), ButtonOut (..),
-                                      ModalIn (..), ModalOut (..))
+import           Component           (ButtonIn (..), ButtonOut (..))
 import qualified Component           as Component
-import           View.Payment.Delete (DeleteIn (..), DeleteOut (..))
+import qualified Component.Modal     as Modal
+import qualified View.Payment.Clone  as Clone
 import qualified View.Payment.Delete as Delete
+import qualified View.Payment.Edit   as Edit
 
 import qualified Icon
-import qualified Util.Dom            as DomUtil
+import qualified Util.Reflex         as ReflexUtil
+
+-- TODO: remove
+import           Debug.Trace         (trace)
 
 data TableIn t = TableIn
   { _tableIn_init              :: Init
@@ -32,17 +39,19 @@ data TableIn t = TableIn
   , _tableIn_payments          :: Dynamic t [Payment]
   , _tableIn_perPage           :: Int
   , _tableIn_paymentCategories :: Dynamic t [PaymentCategory]
+  , _tableIn_categories        :: [Category]
   }
 
 data TableOut t = TableOut
-  { _tableOut_deletePayment :: Event t Payment
+  { _tableOut_addPayment    :: Event t SavedPayment
+  , _tableOut_deletePayment :: Event t Payment
   }
 
 widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
 widget tableIn = do
   R.divClass "table" $ do
 
-    deletePayment <- R.divClass "lines" $ do
+    (addPayment, 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
@@ -52,14 +61,21 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
-      (R.switch . R.current . fmap R.leftmost) <$>
+
+      result <-
         (R.simpleList paymentRange (paymentRow init paymentCategories))
 
-    DomUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
+      return $
+        ( R.switch . R.current . fmap (R.leftmost . map fst) $ result
+        , R.switch . R.current . fmap (R.leftmost . map snd) $ result
+        )
+
+    ReflexUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
       R.text $ Msg.get Msg.Payment_Empty
 
     return $ TableOut
-      { _tableOut_deletePayment = deletePayment
+      { _tableOut_addPayment = addPayment
+      , _tableOut_deletePayment = deletePayment
       }
 
   where
@@ -82,7 +98,7 @@ paymentRow
   => Init
   -> Dynamic t [PaymentCategory]
   -> Dynamic t Payment
-  -> m (Event t Payment)
+  -> m (Event t SavedPayment, Event t Payment)
 paymentRow init paymentCategories payment =
   R.divClass "row" $ do
 
@@ -115,7 +131,7 @@ paymentRow init paymentCategories payment =
             Nothing -> M.singleton "display" "none"
 
       R.elDynAttr "span" attrs $
-        R.dynText $ flip fmap category $ \mbCategory -> case mbCategory of
+        R.dynText $ R.ffor category $ \case
           Just c -> _category_name c
           _      -> ""
 
@@ -123,35 +139,68 @@ paymentRow init paymentCategories payment =
       R.elClass "span" "shortDate" . R.dynText . fmap (Format.shortDay . _payment_date) $ payment
       R.elClass "span" "longDate" . R.dynText . fmap (Format.longDay . _payment_date) $ payment
 
-    R.divClass "cell button" $
-      R.el "button" Icon.clone
+    let categoryId = (Maybe.fromMaybe (-1) . fmap _category_id) <$> category
+
+    clonePayment <-
+      R.divClass "cell button" $
+        _buttonOut_clic <$> (Component.button $
+          Component.defaultButtonIn Icon.clone)
+
+    paymentCloned <-
+      Modal.view $ Modal.Input
+        { Modal._input_show    = clonePayment
+        , Modal._input_content =
+            Clone.view $ Clone.Input
+              { Clone._input_show = clonePayment
+              , Clone._input_categories = _init_categories init
+              , Clone._input_paymentCategories = paymentCategories
+              , Clone._input_payment = payment
+              , Clone._input_category = categoryId
+              }
+        }
 
     let isFromCurrentUser =
           R.ffor
             payment
             (\p -> _payment_user p == _init_currentUser init)
 
-    R.divClass "cell button" $
-      DomUtil.divVisibleIf isFromCurrentUser $
-        R.el "button" Icon.edit
+    editPayment <-
+      R.divClass "cell button" $
+        ReflexUtil.divVisibleIf isFromCurrentUser $
+          _buttonOut_clic <$> (Component.button $
+            Component.defaultButtonIn Icon.edit)
+
+    paymentEdited <-
+      Modal.view $ Modal.Input
+        { Modal._input_show    = editPayment
+        , Modal._input_content =
+            Edit.view $ Edit.Input
+              { Edit._input_show = editPayment
+              , Edit._input_categories = _init_categories init
+              , Edit._input_paymentCategories = paymentCategories
+              , Edit._input_payment = payment
+              , Edit._input_category = categoryId
+              }
+        }
 
     deletePayment <-
       R.divClass "cell button" $
-        DomUtil.divVisibleIf isFromCurrentUser $
+        ReflexUtil.divVisibleIf isFromCurrentUser $
           _buttonOut_clic <$> (Component.button $
             (Component.defaultButtonIn Icon.delete)
-              { _buttonIn_class = R.constDyn "deletePayment" })
-
-    rec
-      modalOut <- Component.modal $ ModalIn
-        { _modalIn_show    = deletePayment
-        , _modalIn_hide = R.leftmost $
-            [ _deleteOut_cancel . _modalOut_content $ modalOut
-            , fmap (const ()) . _deleteOut_validate . _modalOut_content $ modalOut
-            ]
-        , _modalIn_content = Delete.view (DeleteIn { _deleteIn_payment = payment })
+              { _buttonIn_class = R.constDyn "deletePayment"
+              })
+
+    paymentDeleted <-
+      Modal.view $ Modal.Input
+        { Modal._input_show    = deletePayment
+        , Modal._input_content =
+            Delete.view $ Delete.Input
+              { Delete._input_payment = payment
+              }
         }
-    return (_deleteOut_validate . _modalOut_content $ modalOut)
+
+    return $ (paymentCloned, paymentDeleted)
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
diff --git a/common/common.cabal b/common/common.cabal
index 0edd8e2..a454270 100644
--- a/common/common.cabal
+++ b/common/common.cabal
@@ -30,9 +30,9 @@ Library
   Exposed-modules:
     Common.Model
     Common.Model.CreatePayment
-    Common.Model.CreatedPayment
     Common.Model.Email
     Common.Model.Payment
+    Common.Model.SavedPayment
     Common.Model.SignInForm
     Common.Model.User
     Common.Msg
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index 64db890..1abc3e3 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -2,7 +2,6 @@ module Common.Model (module X) where
 
 import           Common.Model.Category        as X
 import           Common.Model.CreateCategory  as X
-import           Common.Model.CreatedPayment  as X
 import           Common.Model.CreateIncome    as X
 import           Common.Model.CreatePayment   as X
 import           Common.Model.Currency        as X
@@ -17,5 +16,6 @@ import           Common.Model.InitResult      as X
 import           Common.Model.Payer           as X
 import           Common.Model.Payment         as X
 import           Common.Model.PaymentCategory as X
+import           Common.Model.SavedPayment    as X
 import           Common.Model.SignInForm      as X
 import           Common.Model.User            as X
diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs
index d2c223f..8860b84 100644
--- a/common/src/Common/Model/EditPayment.hs
+++ b/common/src/Common/Model/EditPayment.hs
@@ -2,7 +2,7 @@ module Common.Model.EditPayment
   ( EditPayment(..)
   ) where
 
-import           Data.Aeson             (FromJSON)
+import           Data.Aeson             (FromJSON, ToJSON)
 import           Data.Text              (Text)
 import           Data.Time.Calendar     (Day)
 import           GHC.Generics           (Generic)
@@ -21,3 +21,4 @@ data EditPayment = EditPayment
   } deriving (Show, Generic)
 
 instance FromJSON EditPayment
+instance ToJSON EditPayment
diff --git a/common/src/Common/Model/CreatedPayment.hs b/common/src/Common/Model/SavedPayment.hs
index c1bba29..f45c479 100644
--- a/common/src/Common/Model/CreatedPayment.hs
+++ b/common/src/Common/Model/SavedPayment.hs
@@ -1,5 +1,5 @@
-module Common.Model.CreatedPayment
-  ( CreatedPayment(..)
+module Common.Model.SavedPayment
+  ( SavedPayment(..)
   ) where
 
 import           Data.Aeson                   (FromJSON, ToJSON)
@@ -8,10 +8,10 @@ import           GHC.Generics                 (Generic)
 import           Common.Model.Payment         (Payment)
 import           Common.Model.PaymentCategory (PaymentCategory)
 
-data CreatedPayment = CreatedPayment
-  { _createdPayment_payment         :: Payment
-  , _createdPayment_paymentCategory :: PaymentCategory
+data SavedPayment = SavedPayment
+  { _savedPayment_payment         :: Payment
+  , _savedPayment_paymentCategory :: PaymentCategory
   } deriving (Show, Generic)
 
-instance FromJSON CreatedPayment
-instance ToJSON CreatedPayment
+instance FromJSON SavedPayment
+instance ToJSON SavedPayment
diff --git a/server/server.cabal b/server/server.cabal
index 3bc8e42..3c1c770 100644
--- a/server/server.cabal
+++ b/server/server.cabal
@@ -74,6 +74,7 @@ Executable server
     Design.View.Payment
     Design.View.Payment.Add
     Design.View.Payment.Delete
+    Design.View.Payment.Form
     Design.View.Payment.Header
     Design.View.Payment.Pages
     Design.View.Payment.Table
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index 3d857be..c700240 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -10,9 +10,9 @@ import qualified Network.HTTP.Types.Status   as Status
 import           Web.Scotty                  hiding (delete)
 
 import           Common.Model                (CreatePayment (..),
-                                              CreatedPayment (..),
                                               EditPayment (..), Payment (..),
-                                              PaymentId, User (..))
+                                              PaymentId, SavedPayment (..),
+                                              User (..))
 import qualified Model.Query                 as Query
 import qualified Persistence.Payment         as PaymentPersistence
 import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
@@ -33,7 +33,7 @@ create createPayment@(CreatePayment name cost date category frequency) =
         (liftIO . Query.run $ do
           pc <- PaymentCategoryPersistence.save name category
           p <- PaymentPersistence.create (_user_id user) name cost date frequency
-          return $ CreatedPayment p pc
+          return $ SavedPayment p pc
         ) >>= json
       Just validationError ->
         do
@@ -44,15 +44,20 @@ create createPayment@(CreatePayment name cost date category frequency) =
 edit :: EditPayment -> ActionM ()
 edit (EditPayment paymentId name cost date category frequency) =
   Secure.loggedAction (\user -> do
-    updated <- liftIO . Query.run $ do
-      edited <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency
-      _ <- if edited
-        then PaymentCategoryPersistence.save name category >> return ()
-        else return ()
-      return edited
-    if updated
-      then status Status.ok200
-      else status Status.badRequest400
+    result <- liftIO . Query.run $ do
+      editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency
+      case editedPayment of
+        Just p -> do
+          pc <- PaymentCategoryPersistence.save name category
+          PaymentCategoryPersistence.deleteIfUnused name
+          return $ Just (p, pc)
+        Nothing ->
+          return Nothing
+    case result of
+      Just (p, pc) ->
+        json $ SavedPayment p pc
+      Nothing ->
+        status Status.badRequest400
   )
 
 delete :: PaymentId -> ActionM ()
diff --git a/server/src/Design/Modal.hs b/server/src/Design/Modal.hs
index dce2ef9..4020eb0 100644
--- a/server/src/Design/Modal.hs
+++ b/server/src/Design/Modal.hs
@@ -7,6 +7,7 @@ import           Data.Monoid                ((<>))
 
 import qualified Design.View.Payment.Add    as Add
 import qualified Design.View.Payment.Delete as Delete
+import qualified Design.View.Payment.Form   as Form
 
 design :: Css
 design = do
@@ -14,9 +15,9 @@ design = do
   appearKeyframe
 
   ".g-Modal" ? do
+    display none
     appearAnimation
     transition "all" (sec 0.2) ease (sec 0)
-    display none
     opacity 0
 
   ".g-Modal--Show" & do
@@ -47,6 +48,7 @@ design = do
     boxShadow . pure . bsColor (rgba 0 0 0 0.5) $ shadowWithBlur (px 0) (px 0) (px 15)
 
     ".add" ? Add.design
+    ".form" ? Form.design
     ".delete" ? Delete.design
 
   ".paymentModal" & do
diff --git a/server/src/Design/View/Payment/Form.hs b/server/src/Design/View/Payment/Form.hs
new file mode 100644
index 0000000..aada12b
--- /dev/null
+++ b/server/src/Design/View/Payment/Form.hs
@@ -0,0 +1,35 @@
+module Design.View.Payment.Form
+  ( design
+  ) where
+
+import           Clay
+
+import qualified Design.Color     as Color
+import qualified Design.Constants as Constants
+import qualified Design.Helper    as Helper
+
+design :: Css
+design = do
+  ".formHeader" ? do
+    backgroundColor Color.chestnutRose
+    fontSize (px 18)
+    color Color.white
+    sym2 padding (px 20) (px 30)
+    textAlign (alignSide sideCenter)
+    borderRadius (px 5) (px 5) (px 0) (px 0)
+
+  ".formContent" ? do
+    sym2 padding (px 20) (px 30)
+
+    ".buttons" ? do
+      display flex
+      justifyContent spaceAround
+      marginTop (em 1.5)
+
+      ".confirm" ?
+        Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
+      ".undo" ?
+        Helper.button Color.silver Color.white (px Constants.inputHeight) Constants.focusLighten
+
+      (".confirm" <> ".undo") ?
+        width (px 90)
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index 3d8f129..b3f2b2e 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -129,33 +129,53 @@ createMany payments =
       (map InsertRow payments)
   )
 
-edit :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
-edit userId paymentId paymentName paymentCost paymentDate paymentFrequency =
+edit :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query (Maybe Payment)
+edit userId paymentId name cost date frequency =
   Query (\conn -> do
     mbPayment <- fmap (\(Row p) -> p) . listToMaybe <$>
-      SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
+      SQLite.query
+        conn
+        "SELECT * FROM payment WHERE id = ? and userId = ?"
+        (paymentId, userId)
     case mbPayment of
-      Just payment ->
-        if _payment_user payment == userId
-          then do
-            now <- getCurrentTime
-            SQLite.execute
-              conn
-              (SQLite.Query $ T.intercalate " "
-                [ "UPDATE payment"
-                , "SET edited_at = ?,"
-                , "    name = ?,"
-                , "    cost = ?,"
-                , "    date = ?,"
-                , "    frequency = ?"
-                , "WHERE id = ?"
-                ])
-              (now, paymentName, paymentCost, paymentDate, FrequencyField paymentFrequency, paymentId)
-            return True
-          else
-            return False
+      Just payment -> do
+        now <- getCurrentTime
+        SQLite.execute
+          conn
+          (SQLite.Query $ T.intercalate " "
+            [ "UPDATE"
+            , "  payment"
+            , "SET"
+            , "  edited_at = ?,"
+            , "  name = ?,"
+            , "  cost = ?,"
+            , "  date = ?,"
+            , "  frequency = ?"
+            , "WHERE"
+            , "  id = ?"
+            , "  AND user_id = ?"
+            ])
+          ( now
+          , name
+          , cost
+          , date
+          , FrequencyField frequency
+          , paymentId
+          , userId
+          )
+        return . Just $ Payment
+          { _payment_id        = paymentId
+          , _payment_user      = userId
+          , _payment_name      = name
+          , _payment_cost      = cost
+          , _payment_date      = date
+          , _payment_frequency = frequency
+          , _payment_createdAt = _payment_createdAt payment
+          , _payment_editedAt  = Just now
+          , _payment_deletedAt = Nothing
+          }
       Nothing ->
-        return False
+        return Nothing
   )
 
 delete :: UserId -> PaymentId -> Query ()