Add payment clone

11 files changed, 512 insertions, 284 deletions

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