From f4f24158a46d8c0975f1b8813bbdbbeebad8c108 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 6 Nov 2019 19:44:15 +0100
Subject: Show the payment table with server side paging

---
 client/client.cabal                |   6 +-
 client/src/Component/Modal.hs      |   2 +-
 client/src/Component/Table.hs      |  21 +--
 client/src/View/App.hs             |   7 +-
 client/src/View/Income/Form.hs     |  18 +-
 client/src/View/Income/Table.hs    |   8 +-
 client/src/View/Payment/Add.hs     |  55 ------
 client/src/View/Payment/Clone.hs   |  61 ------
 client/src/View/Payment/Delete.hs  |  58 ------
 client/src/View/Payment/Edit.hs    |  56 ------
 client/src/View/Payment/Form.hs    | 137 +++++++++-----
 client/src/View/Payment/Header.hs  |   8 +-
 client/src/View/Payment/Pages.hs   |  87 ---------
 client/src/View/Payment/Payment.hs | 367 ++++++++++++++++++++-----------------
 client/src/View/Payment/Reducer.hs |  66 +++++++
 client/src/View/Payment/Table.hs   | 315 +++++++++++++------------------
 16 files changed, 517 insertions(+), 755 deletions(-)
 delete mode 100644 client/src/View/Payment/Add.hs
 delete mode 100644 client/src/View/Payment/Clone.hs
 delete mode 100644 client/src/View/Payment/Delete.hs
 delete mode 100644 client/src/View/Payment/Edit.hs
 delete mode 100644 client/src/View/Payment/Pages.hs
 create mode 100644 client/src/View/Payment/Reducer.hs

(limited to 'client')

diff --git a/client/client.cabal b/client/client.cabal
index 04c8543..75c2c1b 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -75,14 +75,10 @@ Executable client
     View.Income.Reducer
     View.Income.Table
     View.NotFound
-    View.Payment.Add
-    View.Payment.Clone
-    View.Payment.Delete
-    View.Payment.Edit
     View.Payment.Form
     View.Payment.Header
     View.Payment.Init
-    View.Payment.Pages
     View.Payment.Payment
+    View.Payment.Reducer
     View.Payment.Table
     View.SignIn
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index b0533e2..08f2e74 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -72,7 +72,7 @@ view input = do
     let content = R.switchDyn $ (\(_, _, c) -> c) <$> dyn
 
   -- Delay the event in order to let time for the modal to disappear
-  R.delay (0.3 :: NominalDiffTime) content
+  R.delay (0.5 :: NominalDiffTime) content
 
 getAttributes :: Text -> LM.Map Text Text
 getAttributes modalClass =
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index 3b9ec24..2869c2d 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -4,7 +4,7 @@ module Component.Table
   , Out(..)
   ) where
 
-import qualified Data.Map as M
+import qualified Data.Map         as M
 import           Data.Text        (Text)
 import           Reflex.Dom       (Event, MonadWidget)
 import qualified Reflex.Dom       as R
@@ -14,23 +14,23 @@ import qualified Component.Modal  as Modal
 import qualified Util.Reflex      as ReflexUtil
 import qualified View.Icon        as Icon
 
-data In m t h r a = In
+data In m t h r a b c = In
   { _in_headerLabel :: h -> Text
   , _in_rows        :: [r]
-  , _in_cell        :: h -> r -> Text
+  , _in_cell        :: h -> r -> m ()
   , _in_cloneModal  :: r -> Modal.Content t m a
-  , _in_editModal   :: r -> Modal.Content t m a
-  , _in_deleteModal :: r -> Modal.Content t m a
+  , _in_editModal   :: r -> Modal.Content t m b
+  , _in_deleteModal :: r -> Modal.Content t m c
   , _in_isOwner     :: r -> Bool
   }
 
-data Out t a = Out
+data Out t a b c = Out
   { _out_add    :: Event t a
-  , _out_edit   :: Event t a
-  , _out_delete :: Event t a
+  , _out_edit   :: Event t b
+  , _out_delete :: Event t c
   }
 
-view :: forall t m h r a. (MonadWidget t m, Bounded h, Enum h)  => In m t h r a -> m (Out t a)
+view :: forall t m h r a b c. (MonadWidget t m, Bounded h, Enum h)  => In m t h r a b c-> m (Out t a b c)
 view input =
   R.divClass "table" $ do
     rec
@@ -49,8 +49,7 @@ view input =
           R.divClass "row" $ do
             flip mapM_ [minBound..] $ \header ->
               R.divClass "cell" $
-                R.text $
-                  _in_cell input header row
+                _in_cell input header row
 
             cloneButton <-
               R.divClass "cell button" $
diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index d305d00..2b346af 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -58,15 +58,14 @@ widget initResult =
 signedWidget :: MonadWidget t m => Init -> Dynamic t Route -> m ()
 signedWidget init route = do
   R.dyn . R.ffor route $ \case
-    RootRoute -> do
-      paymentInit <- Payment.init
+    RootRoute ->
       Payment.view $ Payment.In
         { Payment._in_currentUser = _init_currentUser init
         , Payment._in_currency = _init_currency init
-        , Payment._in_init = paymentInit
+        , Payment._in_users = _init_users init
         }
 
-    IncomeRoute -> do
+    IncomeRoute ->
       Income.view $ Income.In
         { Income._in_currentUser = _init_currentUser init
         , Income._in_currency = _init_currency init
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
index a4f7de8..ff6e55e 100644
--- a/client/src/View/Income/Form.hs
+++ b/client/src/View/Income/Form.hs
@@ -27,7 +27,7 @@ import qualified Component.Modal          as Modal
 import qualified Component.ModalForm      as ModalForm
 import qualified Util.Ajax                as Ajax
 
-data In t = In
+data In = In
   { _in_operation :: Operation
   }
 
@@ -36,7 +36,7 @@ data Operation
   | Clone Income
   | Edit Income
 
-view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m Income
+view :: forall t m a. MonadWidget t m => In -> Modal.Content t m Income
 view input cancel = do
 
   rec
@@ -94,14 +94,14 @@ view input cancel = do
 
     amount =
       case op of
-        New          -> ""
-        Clone income -> T.pack . show . _income_amount $ income
-        Edit income  -> T.pack . show . _income_amount $ income
+        New     -> ""
+        Clone i -> T.pack . show . _income_amount $ i
+        Edit i  -> T.pack . show . _income_amount $ i
 
     date currentDay =
       case op of
-        Edit income -> _income_date income
-        _           -> currentDay
+        Edit i -> _income_date i
+        _      -> currentDay
 
     ajax =
       case op of
@@ -115,5 +115,5 @@ view input cancel = do
 
     mkPayload =
       case op of
-        Edit income -> \a b -> Aeson.toJSON $ EditIncomeForm (_income_id income) a b
-        _         -> \a b -> Aeson.toJSON $ CreateIncomeForm a b
+        Edit i -> \a b -> Aeson.toJSON $ EditIncomeForm (_income_id i) a b
+        _      -> \a b -> Aeson.toJSON $ CreateIncomeForm a b
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index 32ab27b..c623acb 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -80,14 +80,14 @@ headerLabel UserHeader   = Msg.get Msg.Income_Name
 headerLabel DateHeader   = Msg.get Msg.Income_Date
 headerLabel AmountHeader = Msg.get Msg.Income_Amount
 
-cell :: [User] -> Currency -> Header -> Income -> Text
+cell :: forall t m. MonadWidget t m => [User] -> Currency -> Header -> Income -> m ()
 cell users currency header income =
   case header of
     UserHeader ->
-      Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users
+      R.text . Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users
 
     DateHeader ->
-      Format.longDay . _income_date $ income
+      R.text . Format.longDay . _income_date $ income
 
     AmountHeader ->
-      Format.price currency . _income_amount $ income
+      R.text . Format.price currency . _income_amount $ income
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
deleted file mode 100644
index e983465..0000000
--- a/client/src/View/Payment/Add.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-module View.Payment.Add
-  ( view
-  , In(..)
-  ) where
-
-import           Control.Monad          (join)
-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 (..), CreatePaymentForm (..),
-                                         Frequency (..), Payment (..),
-                                         PaymentCategory (..),
-                                         SavedPayment (..))
-import qualified Common.Msg             as Msg
-import qualified Common.Util.Time       as TimeUtil
-import qualified Component.Modal        as Modal
-import qualified Util.Ajax              as Ajax
-import qualified Util.Reflex            as ReflexUtil
-import qualified View.Payment.Form      as Form
-
-data In t = In
-  { _in_categories        :: [Category]
-  , _in_paymentCategories :: Dynamic t [PaymentCategory]
-  , _in_frequency         :: Dynamic t Frequency
-  }
-
-view :: forall t m. MonadWidget t m => In t -> Modal.Content t m SavedPayment
-view input cancel = do
-
-  currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
-
-  formOutput <- R.dyn $ do
-    paymentCategories <- _in_paymentCategories input
-    frequency <- _in_frequency input
-    return $ Form.view $ Form.In
-      { Form._in_cancel = cancel
-      , Form._in_headerLabel = Msg.get Msg.Payment_Add
-      , Form._in_categories = _in_categories input
-      , Form._in_paymentCategories = paymentCategories
-      , Form._in_name = ""
-      , Form._in_cost = ""
-      , Form._in_date = currentDay
-      , Form._in_category = -1
-      , Form._in_frequency = frequency
-      , Form._in_mkPayload = CreatePaymentForm
-      , Form._in_ajax = Ajax.post
-      }
-
-  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
deleted file mode 100644
index 82b0c27..0000000
--- a/client/src/View/Payment/Clone.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-module View.Payment.Clone
-  ( In(..)
-  , 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,
-                                         CreatePaymentForm (..), Frequency (..),
-                                         Payment (..), PaymentCategory (..),
-                                         SavedPayment (..))
-import qualified Common.Msg             as Msg
-import qualified Common.Util.Time       as TimeUtil
-import qualified Component.Modal        as Modal
-import qualified Util.Ajax              as Ajax
-import qualified Util.Reflex            as ReflexUtil
-import qualified View.Payment.Form      as Form
-
-data In t = In
-  { _in_show              :: Event t ()
-  , _in_categories        :: [Category]
-  , _in_paymentCategories :: Dynamic t [PaymentCategory]
-  , _in_payment           :: Dynamic t Payment
-  , _in_category          :: Dynamic t CategoryId
-  }
-
-view :: forall t m. MonadWidget t m => In t -> Modal.Content t m SavedPayment
-view input cancel = do
-
-  currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
-
-  form <- R.dyn $ do
-    paymentCategories <- _in_paymentCategories input
-    payment <- _in_payment input
-    category <- _in_category input
-    return . Form.view $ Form.In
-      { Form._in_cancel = cancel
-      , Form._in_headerLabel = Msg.get Msg.Payment_CloneLong
-      , Form._in_categories = _in_categories input
-      , Form._in_paymentCategories = paymentCategories
-      , Form._in_name = _payment_name payment
-      , Form._in_cost = T.pack . show . _payment_cost $ payment
-      , Form._in_date = currentDay
-      , Form._in_category = category
-      , Form._in_frequency = _payment_frequency payment
-      , Form._in_mkPayload = CreatePaymentForm
-      , Form._in_ajax = Ajax.post
-      }
-
-  hide <- ReflexUtil.flatten (Form._output_hide <$> form)
-  clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> form)
-
-  return $
-    ( hide
-    , clonePayment
-    )
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
deleted file mode 100644
index e5e7219..0000000
--- a/client/src/View/Payment/Delete.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-module View.Payment.Delete
-  ( In(..)
-  , 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 qualified Component.Button as Button
-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 In t = In
-  { _in_payment :: Dynamic t Payment
-  }
-
-view :: forall t m. MonadWidget t m => (In 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
-
-      (confirm, cancel) <- R.divClass "buttons" $ do
-
-        cancel <- Button._out_clic <$> (Button.view $
-          (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
-            { Button._in_class = R.constDyn "undo" })
-
-        rec
-          confirm <- Button._out_clic <$> (Button.view $
-            (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
-              { Button._in_class = R.constDyn "confirm"
-              , Button._in_submit = True
-              , Button._in_waiting = waiting
-              })
-
-          let url =
-                R.ffor (_in_payment input) (\id ->
-                  T.concat ["/api/payment/", T.pack . show $ _payment_id id]
-                )
-
-          (result, waiting) <- WaitFor.waitFor
-            (Ajax.delete url)
-            confirm
-
-        return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
-
-      return $
-        ( R.leftmost [ cancel, () <$ confirm ]
-        , R.tag (R.current $ _in_payment input) confirm
-        )
diff --git a/client/src/View/Payment/Edit.hs b/client/src/View/Payment/Edit.hs
deleted file mode 100644
index 5cb4537..0000000
--- a/client/src/View/Payment/Edit.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-module View.Payment.Edit
-  ( In(..)
-  , 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,
-                                    EditPaymentForm (..), Frequency (..),
-                                    Payment (..), PaymentCategory (..),
-                                    SavedPayment (..))
-import qualified Common.Msg        as Msg
-import qualified Component.Modal   as Modal
-import qualified Util.Ajax         as Ajax
-import qualified Util.Reflex       as ReflexUtil
-import qualified View.Payment.Form as Form
-
-data In t = In
-  { _in_show              :: Event t ()
-  , _in_categories        :: [Category]
-  , _in_paymentCategories :: Dynamic t [PaymentCategory]
-  , _in_payment           :: Dynamic t Payment
-  , _in_category          :: Dynamic t CategoryId
-  }
-
-view :: forall t m. MonadWidget t m => In t -> Modal.Content t m SavedPayment
-view input cancel = do
-
-  formOutput <- R.dyn $ do
-    paymentCategories <- _in_paymentCategories input
-    payment <- _in_payment input
-    category <- _in_category input
-    return . Form.view $ Form.In
-      { Form._in_cancel = cancel
-      , Form._in_headerLabel = Msg.get Msg.Payment_EditLong
-      , Form._in_categories = _in_categories input
-      , Form._in_paymentCategories = paymentCategories
-      , Form._in_name = _payment_name payment
-      , Form._in_cost = T.pack . show . _payment_cost $ payment
-      , Form._in_date = _payment_date payment
-      , Form._in_category = category
-      , Form._in_frequency = _payment_frequency payment
-      , Form._in_mkPayload = EditPaymentForm (_payment_id payment)
-      , Form._in_ajax = Ajax.put
-      }
-
-  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
index 29768aa..99b0848 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -1,10 +1,12 @@
 module View.Payment.Form
   ( view
   , In(..)
-  , Out(..)
+  , Operation(..)
   ) where
 
-import           Data.Aeson                (ToJSON)
+import           Control.Monad.IO.Class    (liftIO)
+import           Data.Aeson                (Value)
+import qualified Data.Aeson                as Aeson
 import qualified Data.List                 as L
 import           Data.List.NonEmpty        (NonEmpty)
 import qualified Data.Map                  as M
@@ -13,6 +15,7 @@ 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.Time.Clock           as Clock
 import           Data.Validation           (Validation)
 import qualified Data.Validation           as V
 import           Reflex.Dom                (Dynamic, Event, MonadWidget)
@@ -20,103 +23,98 @@ import qualified Reflex.Dom                as R
 import qualified Text.Read                 as T
 
 import           Common.Model              (Category (..), CategoryId,
+                                            CreatePaymentForm (..),
+                                            EditPaymentForm (..),
                                             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.Input           as Input
+import qualified Component.Modal           as Modal
 import qualified Component.ModalForm       as ModalForm
 import qualified Component.Select          as Select
+import qualified Util.Ajax                 as Ajax
 import qualified Util.Validation           as ValidationUtil
 
-data In m t a = In
-  { _in_cancel            :: Event t ()
-  , _in_headerLabel       :: Text
-  , _in_categories        :: [Category]
+data In = In
+  { _in_categories        :: [Category]
   , _in_paymentCategories :: [PaymentCategory]
-  , _in_name              :: Text
-  , _in_cost              :: Text
-  , _in_date              :: Day
-  , _in_category          :: CategoryId
-  , _in_frequency         :: Frequency
-  , _in_mkPayload         :: Text -> Text -> Text -> CategoryId -> Frequency -> a
-  , _in_ajax              :: Text -> Event t a -> m (Event t (Either Text SavedPayment))
+  , _in_operation         :: Operation
   }
 
-data Out t = Out
-  { _output_hide       :: Event t ()
-  , _output_addPayment :: Event t SavedPayment
-  }
+data Operation
+  = New Frequency
+  | Clone Payment
+  | Edit Payment
 
-view :: forall t m a. (MonadWidget t m, ToJSON a) => In m t a -> m (Out t)
-view input = do
+view :: forall t m a. MonadWidget t m => In -> Modal.Content t m SavedPayment
+view input cancel = do
   rec
     let reset = R.leftmost
           [ "" <$ ModalForm._out_cancel modalForm
           , "" <$ ModalForm._out_validate modalForm
-          , "" <$ _in_cancel input
+          , "" <$ cancel
           ]
 
     modalForm <- ModalForm.view $ ModalForm.In
-      { ModalForm._in_headerLabel = _in_headerLabel input
-      , ModalForm._in_ajax        = _in_ajax input "/api/payment"
+      { ModalForm._in_headerLabel = headerLabel
+      , ModalForm._in_ajax        = ajax "/api/payment"
       , ModalForm._in_form        = form reset (ModalForm._out_confirm modalForm)
       }
 
-  return $ Out
-    { _output_hide = ModalForm._out_hide modalForm
-    , _output_addPayment = ModalForm._out_validate modalForm
-    }
+  return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm)
 
   where
+
     form
       :: Event t String
       -> Event t ()
-      -> m (Dynamic t (Validation (NonEmpty Text) a))
+      -> m (Dynamic t (Validation (NonEmpty Text) Value))
     form reset confirm = do
       name <- Input.view
         (Input.defaultIn
           { Input._in_label = Msg.get Msg.Payment_Name
-          , Input._in_initialValue = _in_name input
+          , Input._in_initialValue = name
           , Input._in_validation = PaymentValidation.name
           })
-        (_in_name input <$ reset)
+        (name <$ reset)
         confirm
 
       cost <- Input._out_raw <$> (Input.view
         (Input.defaultIn
           { Input._in_label = Msg.get Msg.Payment_Cost
-          , Input._in_initialValue = _in_cost input
+          , Input._in_initialValue = cost
           , Input._in_validation = PaymentValidation.cost
           })
-        (_in_cost input <$ reset)
+        (cost <$ reset)
         confirm)
 
-      let initialDate = T.pack . Calendar.showGregorian . _in_date $ input
+      d <- date
 
       date <- Input._out_raw <$> (Input.view
         (Input.defaultIn
           { Input._in_label = Msg.get Msg.Payment_Date
-          , Input._in_initialValue = initialDate
+          , Input._in_initialValue = d
           , Input._in_inputType = "date"
           , Input._in_hasResetButton = False
           , Input._in_validation = PaymentValidation.date
           })
-        (initialDate <$ reset)
+        (d <$ reset)
         confirm)
 
       let setCategory =
             R.fmapMaybe id . R.updated $
-              R.ffor (Input._out_raw name) $ \name ->
-                findCategory name (_in_paymentCategories input)
+              R.ffor (Input._out_raw name) findCategory
 
       category <- Select._out_value <$> (Select.view $ Select.In
         { Select._in_label = Msg.get Msg.Payment_Category
-        , Select._in_initialValue = _in_category input
+        , Select._in_initialValue = category
         , Select._in_value = setCategory
         , Select._in_values = R.constDyn categories
-        , Select._in_reset = _in_category input <$ reset
+        , Select._in_reset = category <$ reset
         , Select._in_isValid = PaymentValidation.category (map _category_id $ _in_categories input)
         , Select._in_validate = confirm
         })
@@ -126,12 +124,12 @@ view input = do
         c <- cost
         d <- date
         cat <- category
-        return ((_in_mkPayload input)
+        return (mkPayload
           <$> ValidationUtil.nelError n
           <*> V.Success c
           <*> V.Success d
           <*> ValidationUtil.nelError cat
-          <*> V.Success (_in_frequency input))
+          <*> V.Success frequency)
 
     frequencies =
       M.fromList
@@ -142,7 +140,58 @@ view input = do
     categories = M.fromList . flip map (_in_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)
+    op = _in_operation input
+
+    name =
+      case op of
+        New _   -> ""
+        Clone p -> _payment_name p
+        Edit p  -> _payment_name p
+
+    cost =
+      case op of
+        New _   -> ""
+        Clone p -> T.pack . show . _payment_cost $ p
+        Edit p  -> T.pack . show . _payment_cost $ p
+
+    date = do
+      currentDay <- liftIO $ Clock.getCurrentTime >>= TimeUtil.timeToDay
+      return . T.pack . Calendar.showGregorian $
+        case op of
+          New _   -> currentDay
+          Clone p -> currentDay
+          Edit p  -> _payment_date p
+
+    category =
+      case op of
+        New _   -> -1
+        Clone p -> Maybe.fromMaybe (-1) $ findCategory (_payment_name p)
+        Edit p  -> Maybe.fromMaybe (-1) $ findCategory (_payment_name p)
+
+    frequency =
+      case op of
+        New f   -> f
+        Clone p -> _payment_frequency p
+        Edit p  -> _payment_frequency p
+
+    headerLabel =
+      case op of
+        New _   -> Msg.get Msg.Payment_Add
+        Clone _ -> Msg.get Msg.Payment_CloneLong
+        Edit _  -> Msg.get Msg.Payment_EditLong
+
+    ajax =
+      case op of
+        Edit _ -> Ajax.put
+        _      -> Ajax.post
+
+    mkPayload =
+      case op of
+        Edit p -> \a b c d e -> Aeson.toJSON $ EditPaymentForm (_payment_id p) a b c d e
+        _      -> \a b c d e -> Aeson.toJSON $ CreatePaymentForm a b c d e
+
+    findCategory :: Text -> Maybe CategoryId
+    findCategory paymentName =
+      fmap _paymentCategory_category
+        . L.find ((==) (T.toLower paymentName) . _paymentCategory_name)
+        $ (_in_paymentCategories input)
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 00987a3..c8ca347 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -32,7 +32,7 @@ import qualified Component.Input        as Input
 import qualified Component.Modal        as Modal
 import qualified Component.Select       as Select
 import qualified Util.List              as L
-import qualified View.Payment.Add       as Add
+import qualified View.Payment.Form      as Form
 import           View.Payment.Init      (Init (..))
 
 data In t = In
@@ -120,11 +120,7 @@ payerAndAdd incomes payments users categories paymentCategories currency frequen
 
     Modal.view $ Modal.In
       { Modal._in_show    = addPayment
-      , Modal._in_content = Add.view $ Add.In
-          { Add._in_categories = categories
-          , Add._in_paymentCategories = paymentCategories
-          , Add._in_frequency = frequency
-          }
+      , Modal._in_content = \_ -> return (R.never, R.never) -- TODO
       }
 
 searchLine
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
deleted file mode 100644
index 9a1902c..0000000
--- a/client/src/View/Payment/Pages.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-module View.Payment.Pages
-  ( view
-  , In(..)
-  , Out(..)
-  ) where
-
-import qualified Data.Text        as T
-import           Reflex.Dom       (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom       as R
-
-import qualified Component.Button as Button
-
-import qualified Util.Reflex      as ReflexUtil
-import qualified View.Icon        as Icon
-
-data In t = In
-  { _in_total   :: Dynamic t Int
-  , _in_perPage :: Int
-  , _in_reset   :: Event t ()
-  }
-
-data Out t = Out
-  { _out_currentPage :: Dynamic t Int
-  }
-
-view :: forall t m. MonadWidget t m => In t -> m (Out t)
-view input = do
-  currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
-
-  return $ Out
-    { _out_currentPage = currentPage
-    }
-
-  where
-    total = _in_total input
-    perPage = _in_perPage input
-    reset = _in_reset input
-
-pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
-pageButtons total perPage reset = do
-  R.divClass "pages" $ do
-    rec
-      currentPage <- R.holdDyn 1 . R.leftmost $
-        [ firstPageClic
-        , previousPageClic
-        , pageClic
-        , nextPageClic
-        , lastPageClic
-        , 1 <$ reset
-        ]
-
-      firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
-
-      previousPageClic <- pageButton noCurrentPage (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
-
-      pageClic <- pageEvent <$> (R.simpleList (range <$> currentPage <*> maxPage) $ \p ->
-        pageButton (Just <$> currentPage) p (R.dynText $ fmap (T.pack . show) p))
-
-      nextPageClic <- pageButton noCurrentPage ((\c m -> min (c + 1) m) <$> currentPage <*> maxPage) Icon.doubleRight
-
-      lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
-
-    return currentPage
-
-    where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
-          pageEvent = R.switch . R.current . fmap R.leftmost
-          noCurrentPage = R.constDyn Nothing
-
-range :: Int -> Int -> [Int]
-range currentPage maxPage = [start..end]
-  where sidePages = 2
-        start = max 1 (min (currentPage - sidePages) (maxPage - sidePages * 2))
-        end = min maxPage (start + sidePages * 2)
-
-pageButton :: forall t m. MonadWidget t m => Dynamic t (Maybe Int) -> Dynamic t Int -> m () -> m (Event t Int)
-pageButton currentPage page content = do
-  clic <- Button._out_clic <$> (Button.view $ Button.In
-    { Button._in_class   = do
-        cp <- currentPage
-        p <- page
-        if cp == Just p then "page current" else "page"
-    , Button._in_content = content
-    , Button._in_waiting = R.never
-    , Button._in_tabIndex = Nothing
-    , Button._in_submit = False
-    })
-  return . fmap fst $ R.attach (R.current page) clic
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index e72577f..bf0186f 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -1,181 +1,218 @@
 module View.Payment.Payment
-  ( init
-  , view
+  ( view
   , In(..)
   ) where
 
-import           Data.Text           (Text)
-import qualified Data.Text           as T
-import           Data.Time.Clock     (NominalDiffTime)
-import           Prelude             hiding (init)
-import           Reflex.Dom          (Dynamic, Event, MonadWidget, Reflex)
-import qualified Reflex.Dom          as R
-
-import           Common.Model        (Currency, Frequency, Income (..),
-                                      Payment (..), PaymentCategory (..),
-                                      PaymentId, SavedPayment (..), User,
-                                      UserId)
-import qualified Common.Util.Text    as T
-
-import           Loadable            (Loadable (..))
+import qualified Data.Maybe           as Maybe
+import           Data.Text            (Text)
+import qualified Data.Text            as T
+import           Data.Time.Clock      (NominalDiffTime)
+import           Prelude              hiding (init)
+import           Reflex.Dom           (Dynamic, Event, MonadWidget, Reflex)
+import qualified Reflex.Dom           as R
+
+import           Common.Model         (Currency, Frequency, Income (..),
+                                       Payment (..), PaymentCategory (..),
+                                       PaymentId, PaymentPage (..),
+                                       SavedPayment (..), User, UserId)
+import qualified Common.Util.Text     as T
+
+import qualified Component.Pages      as Pages
+import           Loadable             (Loadable (..))
 import qualified Loadable
-import qualified Util.Ajax           as AjaxUtil
-import qualified View.Payment.Header as Header
-import           View.Payment.Init   (Init (..))
-import qualified View.Payment.Pages  as Pages
-import qualified View.Payment.Table  as Table
-
-init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init))
-init = do
-  users <- AjaxUtil.getNow "api/users"
-  payments <- AjaxUtil.getNow "api/payments"
-  incomes <- AjaxUtil.getNow "api/deprecated/incomes"
-  categories <- AjaxUtil.getNow "api/categories"
-  paymentCategories <- AjaxUtil.getNow "api/paymentCategories"
-  return $ do
-    us <- users
-    ps <- payments
-    is <- incomes
-    cs <- categories
-    pcs <- paymentCategories
-    return $ Init <$> us <*> ps <*> is <*> cs <*> pcs
-
+import qualified Util.Ajax            as AjaxUtil
+import qualified Util.Reflex          as ReflexUtil
+import qualified View.Payment.Header  as Header
+import           View.Payment.Init    (Init (..))
+import qualified View.Payment.Reducer as Reducer
+import qualified View.Payment.Table   as Table
 
 data In t = In
   { _in_currentUser :: UserId
+  , _in_users       :: [User]
   , _in_currency    :: Currency
-  , _in_init        :: Dynamic t (Loadable Init)
   }
 
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input = do
-  R.dyn . R.ffor (_in_init input) . Loadable.view $ \init ->
-
-    R.elClass "main" "payment" $ do
-      rec
-        let addPayment = R.leftmost
-              [ Header._out_addPayment header
-              , Table._out_addPayment table
-              ]
-
-            paymentsPerPage = 7
-
-        payments <- reducePayments
-          (_init_payments init)
-          (_savedPayment_payment <$> addPayment)
-          (_savedPayment_payment <$> Table._out_editPayment table)
-          (Table._out_deletePayment table)
-
-        paymentCategories <- reducePaymentCategories
-          (_init_paymentCategories init)
-          payments
-          (_savedPayment_paymentCategory <$> addPayment)
-          (_savedPayment_paymentCategory <$> Table._out_editPayment table)
-          (Table._out_deletePayment table)
-
-        (searchNameEvent, searchName) <-
-          debounceSearchName (Header._out_searchName header)
-
-        let searchPayments =
-              getSearchPayments searchName (Header._out_searchFrequency header) payments
-
-        header <- Header.view $ Header.In
-          { Header._in_init = init
-          , Header._in_currency = _in_currency input
-          , Header._in_payments = payments
-          , Header._in_searchPayments = searchPayments
-          , Header._in_paymentCategories = paymentCategories
-          }
-
-        table <- Table.view $ Table.In
-          { Table._in_init = init
-          , Table._in_currency = _in_currency input
-          , Table._in_currentUser = _in_currentUser input
-          , Table._in_currentPage = Pages._out_currentPage pages
-          , Table._in_payments = searchPayments
-          , Table._in_perPage = paymentsPerPage
-          , Table._in_paymentCategories = paymentCategories
-          }
-
-        pages <- Pages.view $ Pages.In
-          { Pages._in_total = length <$> searchPayments
-          , Pages._in_perPage = paymentsPerPage
-          , Pages._in_reset = R.leftmost $
-              [ () <$ searchNameEvent
-              , () <$ Header._out_addPayment header
-              ]
-          }
-
-      pure ()
+
+  categoriesEvent <- (AjaxUtil.getNow "api/categories")
+
+  R.dyn . R.ffor categoriesEvent . Loadable.view $ \categories -> do
+
+    rec
+      payments <- Reducer.reducer $ Reducer.In
+        { Reducer._in_newPage      = newPage
+        , Reducer._in_currentPage  = currentPage
+        , Reducer._in_addPayment    = R.leftmost [headerAddPayment, tableAddPayment]
+        , Reducer._in_editPayment   = editPayment
+        , Reducer._in_deletePayment = deletePayment
+        }
+
+      let eventFromResult :: forall a. (((), Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
+          eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
+
+      newPage <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
+      currentPage <- R.holdDyn 1 newPage
+      -- headerAddPayment <- eventFromResult $ Header._out_add . (\(a, _, _) -> a)
+      let headerAddPayment = R.never
+      tableAddPayment <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
+      editPayment <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
+      deletePayment <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
+
+      result <- R.dyn . R.ffor ((,) <$> payments <*> currentPage) $ \(is, p) ->
+        flip Loadable.view is $ \(PaymentPage payments paymentCategories count) -> do
+          table <- Table.view $ Table.In
+            { Table._in_users = _in_users input
+            , Table._in_currentUser = _in_currentUser input
+            , Table._in_categories = categories
+            , Table._in_currency = _in_currency input
+            , Table._in_payments = payments
+            , Table._in_paymentCategories = paymentCategories
+            }
+
+          pages <- Pages.view $ Pages.In
+            { Pages._in_total = R.constDyn count
+            , Pages._in_perPage = Reducer.perPage
+            , Pages._in_page = p
+            }
+
+          return ((), table, pages)
+
+    return ()
 
   return ()
 
-debounceSearchName
-  :: forall t m. MonadWidget t m
-  => Dynamic t Text
-  -> m (Event t Text, Dynamic t Text)
-debounceSearchName searchName = do
-  event <- R.debounce (0.5 :: NominalDiffTime) (R.updated searchName)
-  dynamic <- R.holdDyn "" event
-  return (event, dynamic)
-
-reducePayments
-  :: forall t m. MonadWidget t m
-  => [Payment]
-  -> Event t Payment -- add payment
-  -> Event t Payment -- edit payment
-  -> Event t Payment -- delete payment
-  -> m (Dynamic t [Payment])
-reducePayments initPayments addPayment editPayment deletePayment =
-  R.foldDyn id initPayments $ R.leftmost
-    [ (:) <$> addPayment
-    , R.ffor editPayment (\p -> (p:) . filter ((/= (_payment_id p)) . _payment_id))
-    , R.ffor deletePayment (\p -> filter ((/= (_payment_id p)) . _payment_id))
-    ]
-
-reducePaymentCategories
-  :: forall t m. MonadWidget t m
-  => [PaymentCategory]
-  -> Dynamic t [Payment]      -- payments
-  -> Event t PaymentCategory  -- add payment category
-  -> Event t PaymentCategory  -- edit payment category
-  -> Event t Payment          -- delete payment
-  -> m (Dynamic t [PaymentCategory])
-reducePaymentCategories
-  initPaymentCategories
-  payments
-  addPaymentCategory
-  editPaymentCategory
-  deletePayment
-    =
-  R.foldDyn id initPaymentCategories $ R.leftmost
-    [ (:) <$> addPaymentCategory
-    , R.ffor editPaymentCategory (\pc -> (pc:) . filter ((/= (_paymentCategory_name pc)) . _paymentCategory_name))
-    , R.ffor deletePaymentName (\name -> filter ((/=) (T.toLower name) . _paymentCategory_name))
-    ]
-  where
-    deletePaymentName =
-      R.attachWithMaybe
-        (\ps p ->
-          if any (\p2 -> _payment_id p2 /= _payment_id p && lowerName p2 == lowerName p) ps then
-            Nothing
-          else
-            Just (_payment_name p))
-        (R.current payments)
-        deletePayment
-    lowerName = T.toLower . _payment_name
-
-getSearchPayments
-  :: forall t. Reflex t
-  => Dynamic t Text
-  -> Dynamic t Frequency
-  -> Dynamic t [Payment]
-  -> Dynamic t [Payment]
-getSearchPayments name frequency payments = do
-  n <- name
-  f <- frequency
-  ps <- payments
-  pure $ flip filter ps (\p ->
-    (  (T.search n (_payment_name p) || T.search n (T.pack . show . _payment_cost $ p))
-    && (_payment_frequency p == f)
-    ))
+
+-- view :: forall t m. MonadWidget t m => In t -> m ()
+-- view input = do
+--   R.dyn . R.ffor (_in_init input) . Loadable.view $ \init ->
+--
+--     R.elClass "main" "payment" $ do
+--       rec
+--         let addPayment = R.leftmost
+--               -- [ Header._out_addPayment header
+--               [ Table2._out_addPayment table
+--               ]
+--
+--             paymentsPerPage = 7
+--
+--         payments <- reducePayments
+--           (_init_payments init)
+--           (_savedPayment_payment <$> addPayment)
+--           (_savedPayment_payment <$> Table2._out_editPayment table)
+--           (Table2._out_deletePayment table)
+--
+--         paymentCategories <- reducePaymentCategories
+--           (_init_paymentCategories init)
+--           payments
+--           (_savedPayment_paymentCategory <$> addPayment)
+--           (_savedPayment_paymentCategory <$> Table2._out_editPayment table)
+--           (Table2._out_deletePayment table)
+--
+--         -- (searchNameEvent, searchName) <-
+--         --   debounceSearchName (Header._out_searchName header)
+--
+--         -- let searchPayments =
+--         --       getSearchPayments searchName (Header._out_searchFrequency header) payments
+--
+--         -- header <- Header.view $ Header.In
+--         --   { Header._in_init = init
+--         --   , Header._in_currency = _in_currency input
+--         --   , Header._in_payments = payments
+--         --   , Header._in_searchPayments = searchPayments
+--         --   , Header._in_paymentCategories = paymentCategories
+--         --   }
+--
+--         table <- Table2.view $ Table2.In
+--           { Table2._in_init = init
+--           , Table2._in_currency = _in_currency input
+--           , Table2._in_currentUser = _in_currentUser input
+--           , Table2._in_currentPage = Pages2._out_currentPage pages
+--           , Table2._in_payments = payments
+--           , Table2._in_perPage = paymentsPerPage
+--           , Table2._in_paymentCategories = paymentCategories
+--           }
+--
+--         pages <- Pages2.view $ Pages2.In
+--           { Pages2._in_total = length <$> payments
+--           , Pages2._in_perPage = paymentsPerPage
+--           , Pages2._in_reset = R.never
+--               -- [ () <$ searchNameEvent
+--               -- [ () <$ Header._out_addPayment header
+--               -- ]
+--           }
+--
+--       pure ()
+--
+--   return ()
+--
+-- -- debounceSearchName
+-- --   :: forall t m. MonadWidget t m
+-- --   => Dynamic t Text
+-- --   -> m (Event t Text, Dynamic t Text)
+-- -- debounceSearchName searchName = do
+-- --   event <- R.debounce (0.5 :: NominalDiffTime) (R.updated searchName)
+-- --   dynamic <- R.holdDyn "" event
+-- --   return (event, dynamic)
+--
+-- reducePayments
+--   :: forall t m. MonadWidget t m
+--   => [Payment]
+--   -> Event t Payment -- add payment
+--   -> Event t Payment -- edit payment
+--   -> Event t Payment -- delete payment
+--   -> m (Dynamic t [Payment])
+-- reducePayments initPayments addPayment editPayment deletePayment =
+--   R.foldDyn id initPayments $ R.leftmost
+--     [ (:) <$> addPayment
+--     , R.ffor editPayment (\p -> (p:) . filter ((/= (_payment_id p)) . _payment_id))
+--     , R.ffor deletePayment (\p -> filter ((/= (_payment_id p)) . _payment_id))
+--     ]
+--
+-- reducePaymentCategories
+--   :: forall t m. MonadWidget t m
+--   => [PaymentCategory]
+--   -> Dynamic t [Payment]      -- payments
+--   -> Event t PaymentCategory  -- add payment category
+--   -> Event t PaymentCategory  -- edit payment category
+--   -> Event t Payment          -- delete payment
+--   -> m (Dynamic t [PaymentCategory])
+-- reducePaymentCategories
+--   initPaymentCategories
+--   payments
+--   addPaymentCategory
+--   editPaymentCategory
+--   deletePayment
+--     =
+--   R.foldDyn id initPaymentCategories $ R.leftmost
+--     [ (:) <$> addPaymentCategory
+--     , R.ffor editPaymentCategory (\pc -> (pc:) . filter ((/= (_paymentCategory_name pc)) . _paymentCategory_name))
+--     , R.ffor deletePaymentName (\name -> filter ((/=) (T.toLower name) . _paymentCategory_name))
+--     ]
+--   where
+--     deletePaymentName =
+--       R.attachWithMaybe
+--         (\ps p ->
+--           if any (\p2 -> _payment_id p2 /= _payment_id p && lowerName p2 == lowerName p) ps then
+--             Nothing
+--           else
+--             Just (_payment_name p))
+--         (R.current payments)
+--         deletePayment
+--     lowerName = T.toLower . _payment_name
+--
+-- -- getSearchPayments
+-- --   :: forall t. Reflex t
+-- --   => Dynamic t Text
+-- --   -> Dynamic t Frequency
+-- --   -> Dynamic t [Payment]
+-- --   -> Dynamic t [Payment]
+-- -- getSearchPayments name frequency payments = do
+-- --   n <- name
+-- --   f <- frequency
+-- --   ps <- payments
+-- --   pure $ flip filter ps (\p ->
+-- --     (  (T.search n (_payment_name p) || T.search n (T.pack . show . _payment_cost $ p))
+-- --     && (_payment_frequency p == f)
+-- --     ))
diff --git a/client/src/View/Payment/Reducer.hs b/client/src/View/Payment/Reducer.hs
new file mode 100644
index 0000000..0c70f8a
--- /dev/null
+++ b/client/src/View/Payment/Reducer.hs
@@ -0,0 +1,66 @@
+module View.Payment.Reducer
+  ( perPage
+  , reducer
+  , In(..)
+  ) 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 (PaymentPage)
+
+import           Loadable     (Loadable (..))
+import qualified Loadable     as Loadable
+import qualified Util.Ajax    as AjaxUtil
+
+perPage :: Int
+perPage = 7
+
+data In t a b c = In
+  { _in_newPage       :: Event t Int
+  , _in_currentPage   :: Dynamic t Int
+  , _in_addPayment    :: Event t a
+  , _in_editPayment   :: Event t b
+  , _in_deletePayment :: Event t c
+  }
+
+data Action
+  = LoadPage Int
+  | GetResult (Either Text PaymentPage)
+
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable PaymentPage))
+reducer input = do
+
+  postBuild <- R.getPostBuild
+
+  let loadPage =
+        R.leftmost
+          [ 1 <$ postBuild
+          , _in_newPage input
+          , 1 <$ _in_addPayment input
+          , R.tag (R.current $ _in_currentPage input) (_in_editPayment input)
+          , R.tag (R.current $ _in_currentPage input) (_in_deletePayment input)
+          ]
+
+  getResult <- AjaxUtil.get $ fmap pageUrl loadPage
+
+  R.foldDyn
+    (\action _ -> case action of
+      LoadPage _                 -> Loading
+      GetResult (Left err)       -> Error err
+      GetResult (Right payments) -> Loaded payments
+    )
+    Loading
+    (R.leftmost
+      [ LoadPage <$> loadPage
+      , GetResult <$> getResult
+      ])
+
+  where
+    pageUrl p =
+      "api/payments?page="
+      <> (T.pack . show $ p)
+      <> "&perPage="
+      <> (T.pack . show $ perPage)
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 0793836..dde5168 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -4,209 +4,146 @@ module View.Payment.Table
   , Out(..)
   ) where
 
-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 (..), Currency,
-                                      Frequency (Punctual), Payment (..),
-                                      PaymentCategory (..), SavedPayment,
-                                      User (..), UserId)
-import qualified Common.Model        as CM
-import qualified Common.Msg          as Msg
-import qualified Common.View.Format  as Format
-import qualified Component.Button    as Button
-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           View.Payment.Init   (Init (..))
-
-import qualified Util.Reflex         as ReflexUtil
-import qualified View.Icon           as Icon
+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           Reflex.Dom              (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom              as R
+
+import           Common.Model            (Category (..), Currency, Payment (..),
+                                          PaymentCategory (..), SavedPayment,
+                                          User (..), UserId)
+import qualified Common.Model            as CM
+import qualified Common.Msg              as Msg
+import qualified Common.View.Format      as Format
+
+import qualified Component.ConfirmDialog as ConfirmDialog
+import qualified Component.Table         as Table
+import qualified Util.Ajax               as Ajax
+import qualified Util.Either             as EitherUtil
+import qualified View.Payment.Form       as Form
 
 data In t = In
-  { _in_init              :: Init
-  , _in_currency          :: Currency
+  { _in_users             :: [User]
   , _in_currentUser       :: UserId
-  , _in_currentPage       :: Dynamic t Int
-  , _in_payments          :: Dynamic t [Payment]
-  , _in_perPage           :: Int
-  , _in_paymentCategories :: Dynamic t [PaymentCategory]
   , _in_categories        :: [Category]
+  , _in_currency          :: Currency
+  , _in_payments          :: [Payment]
+  , _in_paymentCategories :: [PaymentCategory]
   }
 
 data Out t = Out
-  { _out_addPayment    :: Event t SavedPayment
-  , _out_editPayment   :: Event t SavedPayment
-  , _out_deletePayment :: Event t Payment
+  { _out_add    :: Event t SavedPayment
+  , _out_edit   :: Event t SavedPayment
+  , _out_delete :: Event t Payment
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
 view input = do
-  R.divClass "table" $ do
-
-    (addPayment, editPayment, deletePayment) <- R.divClass "lines" $ do
-      R.divClass "header" $ do
-        R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
-        R.divClass "cell cost" $ R.text $ Msg.get Msg.Payment_Cost
-        R.divClass "cell user" $ R.text $ Msg.get Msg.Payment_User
-        R.divClass "cell category" $ R.text $ Msg.get Msg.Payment_Category
-        R.divClass "cell date" $ R.text $ Msg.get Msg.Payment_Date
-        R.divClass "cell" $ R.blank
-        R.divClass "cell" $ R.blank
-        R.divClass "cell" $ R.blank
-
-      result <-
-        (R.simpleList paymentRange (paymentRow init currency currentUser paymentCategories))
-
-      return $
-        ( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
-        , R.switch . R.current . fmap (R.leftmost . map (\(_, b, _) -> b)) $ result
-        , R.switch . R.current . fmap (R.leftmost . map (\(_, _, c) -> c)) $ result
-        )
-
-    ReflexUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
-      R.text $ Msg.get Msg.Payment_Empty
-
-    return $ Out
-      { _out_addPayment = addPayment
-      , _out_editPayment = editPayment
-      , _out_deletePayment = deletePayment
-      }
-
-  where
-    init = _in_init input
-    currency = _in_currency input
-    currentUser = _in_currentUser input
-    currentPage = _in_currentPage input
-    payments = _in_payments input
-    paymentRange = getPaymentRange (_in_perPage input) <$> payments <*> currentPage
-    paymentCategories = _in_paymentCategories input
-
-getPaymentRange :: Int -> [Payment] -> Int -> [Payment]
-getPaymentRange perPage payments currentPage =
-  take perPage
-    . drop ((currentPage - 1) * perPage)
-    . reverse
-    . L.sortOn _payment_date
-    $ payments
-
-paymentRow
-  :: forall t m. MonadWidget t m
-  => Init
-  -> Currency
-  -> UserId
-  -> Dynamic t [PaymentCategory]
-  -> Dynamic t Payment
-  -> m (Event t SavedPayment, Event t SavedPayment, Event t Payment)
-paymentRow init currency currentUser paymentCategories payment =
-  R.divClass "row" $ do
-
-    R.divClass "cell name" $
-      R.dynText $ fmap _payment_name payment
-
-    R.divClass "cell cost" $
-      R.dynText $ fmap (Format.price currency . _payment_cost) payment
-
-    let user = R.ffor payment (\p ->
-          CM.findUser (_payment_user p) (_init_users init))
-
-    R.divClass "cell user" $
-      R.dynText $ flip fmap user $ \mbUser -> case mbUser of
-        Just u -> _user_name u
-        _      -> ""
-
-    let category = do
-          p <- payment
-          pcs <- paymentCategories
-          return $ findCategory (_init_categories init) pcs (_payment_name p)
-
-    R.divClass "cell category" $ do
-
-      let attrs = flip fmap category $ \maybeCategory -> case maybeCategory of
-            Just c -> M.fromList
-              [ ("class", "tag")
-              , ("style", T.concat [ "background-color: ", _category_color c ])
-              ]
-            Nothing -> M.singleton "display" "none"
-
-      R.elDynAttr "span" attrs $
-        R.dynText $ R.ffor category $ \case
-          Just c -> _category_name c
-          _      -> ""
-
-    R.divClass "cell date" $ do
-      R.elClass "span" "shortDate" . R.dynText . fmap (Format.shortDay . _payment_date) $ payment
-      R.elClass "span" "longDate" . R.dynText . fmap (Format.longDay . _payment_date) $ payment
-
-    let categoryId = (Maybe.fromMaybe (-1) . fmap _category_id) <$> category
-
-    clonePayment <-
-      R.divClass "cell button" $
-        Button._out_clic <$> (Button.view $
-          Button.defaultIn Icon.clone)
-
-    paymentCloned <-
-      Modal.view $ Modal.In
-        { Modal._in_show    = clonePayment
-        , Modal._in_content =
-            Clone.view $ Clone.In
-              { Clone._in_show = clonePayment
-              , Clone._in_categories = _init_categories init
-              , Clone._in_paymentCategories = paymentCategories
-              , Clone._in_payment = payment
-              , Clone._in_category = categoryId
-              }
-        }
 
-    let isFromCurrentUser =
-          R.ffor
-            payment
-            (\p -> _payment_user p == currentUser)
-
-    editPayment <-
-      R.divClass "cell button" $
-        ReflexUtil.divVisibleIf isFromCurrentUser $
-          Button._out_clic <$> (Button.view $
-            Button.defaultIn Icon.edit)
-
-    paymentEdited <-
-      Modal.view $ Modal.In
-        { Modal._in_show    = editPayment
-        , Modal._in_content =
-            Edit.view $ Edit.In
-              { Edit._in_show = editPayment
-              , Edit._in_categories = _init_categories init
-              , Edit._in_paymentCategories = paymentCategories
-              , Edit._in_payment = payment
-              , Edit._in_category = categoryId
-              }
+  table <- Table.view $ Table.In
+    { Table._in_headerLabel = headerLabel
+    , Table._in_rows = reverse . L.sortOn _payment_date $ _in_payments input
+    , Table._in_cell =
+      cell
+        (_in_users input)
+        (_in_categories input)
+        (_in_paymentCategories input)
+        (_in_currency input)
+    , Table._in_cloneModal = \payment ->
+      Form.view $ Form.In
+        { Form._in_categories = _in_categories input
+        , Form._in_paymentCategories = _in_paymentCategories input
+        , Form._in_operation = Form.Clone payment
         }
-
-    deletePayment <-
-      R.divClass "cell button" $
-        ReflexUtil.divVisibleIf isFromCurrentUser $
-          Button._out_clic <$> (Button.view $
-            (Button.defaultIn Icon.delete)
-              { Button._in_class = R.constDyn "deletePayment"
-              })
-
-    paymentDeleted <-
-      Modal.view $ Modal.In
-        { Modal._in_show    = deletePayment
-        , Modal._in_content =
-            Delete.view $ Delete.In
-              { Delete._in_payment = payment
-              }
+    , Table._in_editModal = \payment ->
+      Form.view $ Form.In
+        { Form._in_categories = _in_categories input
+        , Form._in_paymentCategories = _in_paymentCategories input
+        , Form._in_operation = Form.Edit payment
         }
-
-    return $ (paymentCloned, paymentEdited, paymentDeleted)
+    , Table._in_deleteModal = \payment ->
+      ConfirmDialog.view $ ConfirmDialog.In
+        { ConfirmDialog._in_header  = Msg.get Msg.Payment_DeleteConfirm
+        , ConfirmDialog._in_confirm = \e -> do
+          res <- Ajax.delete
+            (R.constDyn $ T.concat ["/api/payment/", T.pack . show $ _payment_id payment])
+            e
+          return $ payment <$ R.fmapMaybe EitherUtil.eitherToMaybe res
+        }
+    , Table._in_isOwner = (== (_in_currentUser input)) . _payment_user
+    }
+
+  return $ Out
+    { _out_add = Table._out_add table
+    , _out_edit = Table._out_edit table
+    , _out_delete = Table._out_delete table
+    }
+
+data Header
+  = NameHeader
+  | CostHeader
+  | UserHeader
+  | CategoryHeader
+  | DateHeader
+  deriving (Eq, Show, Bounded, Enum)
+
+headerLabel :: Header -> Text
+headerLabel NameHeader     = Msg.get Msg.Payment_Name
+headerLabel CostHeader     = Msg.get Msg.Payment_Cost
+headerLabel UserHeader     = Msg.get Msg.Payment_User
+headerLabel CategoryHeader = Msg.get Msg.Payment_Category
+headerLabel DateHeader     = Msg.get Msg.Payment_Date
+
+cell
+  :: forall t m. MonadWidget t m
+  => [User]
+  -> [Category]
+  -> [PaymentCategory]
+  -> Currency
+  -> Header
+  -> Payment
+  -> m ()
+cell users categories paymentCategories currency header payment =
+  case header of
+    NameHeader ->
+      R.text $ _payment_name payment
+
+    CostHeader ->
+      R.text . Format.price currency . _payment_cost $ payment
+
+    UserHeader ->
+      R.text . Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_payment_user payment) users
+
+    CategoryHeader ->
+      let
+        category =
+          findCategory categories paymentCategories (_payment_name payment)
+
+        attrs =
+          case category of
+            Just c ->
+              M.fromList
+                [ ("class", "tag")
+                , ("style", T.concat [ "background-color: ", _category_color c ])
+                ]
+
+            Nothing ->
+              M.singleton "display" "none"
+      in
+        R.elAttr "span" attrs $
+          R.text $
+            Maybe.fromMaybe "" (_category_name <$> category)
+
+    DateHeader ->
+      do
+        R.elClass "span" "shortDate" $
+          R.text . Format.shortDay . _payment_date $ payment
+
+        R.elClass "span" "longDate" $
+          R.text . Format.longDay . _payment_date $ payment
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
-- 
cgit v1.2.3