From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 8 Nov 2017 23:47:26 +0100
Subject: Use a better project structure

---
 client/src/View/Payment/Table.hs | 90 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)
 create mode 100644 client/src/View/Payment/Table.hs

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
new file mode 100644
index 0000000..f3eb9a7
--- /dev/null
+++ b/client/src/View/Payment/Table.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings         #-}
+{-# LANGUAGE RecursiveDo               #-}
+
+module View.Payment.Table
+  ( widget
+  , TableIn(..)
+  , TableOut(..)
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.List as L
+import qualified Data.Map as M
+import Prelude hiding (init)
+import Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import Common.Model (Payment(..), PaymentCategory(..), Category(..), User(..), Init(..))
+import qualified Common.Model as CM
+import qualified Common.Util.Text as T
+import qualified Common.View.Format as Format
+
+import qualified Icon
+
+data TableIn = TableIn
+  { _tableIn_init :: Init
+  }
+
+data TableOut = TableOut
+  {
+  }
+
+widget :: forall t m. MonadWidget t m => TableIn -> m TableOut
+widget tableIn = do
+  R.divClass "table" $
+    R.divClass "lines" $ do
+      R.divClass "header" $ do
+        R.divClass "cell name" $ R.text $ Message.get Key.Payment_Name
+        R.divClass "cell cost" $ R.text $ Message.get Key.Payment_Cost
+        R.divClass "cell user" $ R.text $ Message.get Key.Payment_User
+        R.divClass "cell category" $ R.text $ Message.get Key.Payment_Category
+        R.divClass "cell date" $ R.text $ Message.get Key.Payment_Date
+        R.divClass "cell" $ R.blank
+        R.divClass "cell" $ R.blank
+        R.divClass "cell" $ R.blank
+      let init = _tableIn_init tableIn
+          payments = _init_payments init
+      mapM_
+        (paymentRow init)
+        (take 8 . reverse . L.sortOn _payment_date $ payments)
+  return $ TableOut {}
+
+paymentRow :: forall t m. MonadWidget t m => Init -> Payment -> m ()
+paymentRow init payment =
+  R.divClass "row" $ do
+    R.divClass "cell name" . R.text $ _payment_name payment
+    R.divClass "cell cost" . R.text . Format.price (_init_currency init) $ _payment_cost payment
+    R.divClass "cell user" $
+      case CM.findUser (_payment_user payment) (_init_users init) of
+        Just user -> R.text (_user_name user)
+        _ -> R.blank
+    R.divClass "cell category" $
+      case findCategory (_init_categories init) (_init_paymentCategories init) (_payment_name payment) of
+        Just category ->
+          R.elAttr "span" (M.fromList [("class", "tag"), ("style", T.concat [ "background-color: ", _category_color category ])]) $
+            R.text $ _category_name category
+        _ ->
+          R.blank
+    R.divClass "cell date" $ do
+      R.elClass "span" "shortDate" . R.text $ Format.shortDay (_payment_date payment)
+      R.elClass "span" "longDate" . R.text $ Format.longDay (_payment_date payment)
+    R.divClass "cell button" . R.el "button" $ Icon.clone
+    R.divClass "cell button" $
+      if _payment_user payment == (_init_currentUser init)
+        then R.el "button" $ Icon.edit
+        else R.blank
+    R.divClass "cell button" $
+      if _payment_user payment == (_init_currentUser init)
+        then R.el "button" $ Icon.delete
+        else R.blank
+
+findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
+findCategory categories paymentCategories paymentName = do
+  paymentCategory <- L.find
+    ((== (T.unaccent . T.toLower) paymentName) . _paymentCategory_name)
+    paymentCategories
+  L.find ((== (_paymentCategory_category paymentCategory)) . _category_id) categories
-- 
cgit v1.2.3


From 213cf7ede058b781fc957de2cd9f6a5988c08004 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 12 Nov 2017 22:58:23 +0100
Subject: Add mocked pages

---
 client/src/View/Payment/Pages.hs | 42 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)
 create mode 100644 client/src/View/Payment/Pages.hs

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
new file mode 100644
index 0000000..f9a2b4e
--- /dev/null
+++ b/client/src/View/Payment/Pages.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings         #-}
+{-# LANGUAGE RecursiveDo               #-}
+
+module View.Payment.Pages
+  ( widget
+  , PagesIn(..)
+  , PagesOut(..)
+  ) where
+
+import qualified Data.Text as T
+import Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Payment(..))
+
+import qualified Icon
+
+data PagesIn = PagesIn
+  { _pagesIn_payments :: [Payment]
+  }
+
+data PagesOut = PagesOut
+  {
+  }
+
+widget :: forall t m. MonadWidget t m => PagesIn -> m PagesOut
+widget _ = do
+  R.divClass "pages" $ do
+    page Icon.doubleLeftBar
+    page Icon.doubleLeft
+    page (R.text . T.pack . show $ (1 :: Integer))
+    page (R.text . T.pack . show $ (2 :: Integer))
+    page (R.text . T.pack . show $ (3 :: Integer))
+    page (R.text . T.pack . show $ (4 :: Integer))
+    page (R.text . T.pack . show $ (5 :: Integer))
+    page Icon.doubleRight
+    page Icon.doubleRightBar
+  return $ PagesOut {}
+
+page :: forall t m. MonadWidget t m => m () -> m ()
+page content = R.elClass "button" "page" $ content
-- 
cgit v1.2.3


From 5a63f7be9375e3ab888e4232dd7ef72c2f1ffae1 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 13 Nov 2017 23:56:40 +0100
Subject: Setup stylish-haskell

---
 client/src/View/Payment/Pages.hs |  57 +++++++++++++---------
 client/src/View/Payment/Table.hs | 102 ++++++++++++++++++++++-----------------
 2 files changed, 92 insertions(+), 67 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index f9a2b4e..cf3e115 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -1,6 +1,5 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE RecursiveDo               #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecursiveDo       #-}
 
 module View.Payment.Pages
   ( widget
@@ -8,35 +7,45 @@ module View.Payment.Pages
   , PagesOut(..)
   ) where
 
-import qualified Data.Text as T
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.Text    as T
+import           Reflex.Dom   (Event, Dynamic, MonadWidget)
+import qualified Reflex.Dom   as R
 
-import Common.Model (Payment(..))
+import           Common.Model (Payment (..))
 
+import           Component    (ButtonIn (..), ButtonOut (..))
+import qualified Component    as Component
 import qualified Icon
 
 data PagesIn = PagesIn
   { _pagesIn_payments :: [Payment]
   }
 
-data PagesOut = PagesOut
-  {
+data PagesOut t = PagesOut
+  { _pagesOut_currentPage :: Dynamic t Int
   }
 
-widget :: forall t m. MonadWidget t m => PagesIn -> m PagesOut
+widget :: forall t m. MonadWidget t m => PagesIn -> m (PagesOut t)
 widget _ = do
-  R.divClass "pages" $ do
-    page Icon.doubleLeftBar
-    page Icon.doubleLeft
-    page (R.text . T.pack . show $ (1 :: Integer))
-    page (R.text . T.pack . show $ (2 :: Integer))
-    page (R.text . T.pack . show $ (3 :: Integer))
-    page (R.text . T.pack . show $ (4 :: Integer))
-    page (R.text . T.pack . show $ (5 :: Integer))
-    page Icon.doubleRight
-    page Icon.doubleRightBar
-  return $ PagesOut {}
-
-page :: forall t m. MonadWidget t m => m () -> m ()
-page content = R.elClass "button" "page" $ content
+  currentPage <- R.divClass "pages" $ do
+    a <- page 1 Icon.doubleLeftBar
+    b <- page 1 Icon.doubleLeft
+    c <- page 1 (R.text . T.pack . show $ (1 :: Integer))
+    d <- page 2 (R.text . T.pack . show $ (2 :: Integer))
+    e <- page 3 (R.text . T.pack . show $ (3 :: Integer))
+    f <- page 4 (R.text . T.pack . show $ (4 :: Integer))
+    g <- page 5 (R.text . T.pack . show $ (5 :: Integer))
+    h <- page 5 Icon.doubleRight
+    i <- page 5 Icon.doubleRightBar
+    R.holdDyn 1 $ R.leftmost [ a, b, c, d, e, f, g, h, i ]
+  return $ PagesOut
+    { _pagesOut_currentPage = currentPage
+    }
+
+page :: forall t m. MonadWidget t m => Int -> m () -> m (Event t Int)
+page n content =
+  ((fmap (const n)) . _buttonOut_clic) <$> (Component.button $ ButtonIn
+    { _buttonIn_class   = "page"
+    , _buttonIn_content = content
+    , _buttonIn_waiting = R.never
+    })
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index f3eb9a7..734511d 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -1,6 +1,5 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE RecursiveDo               #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecursiveDo       #-}
 
 module View.Payment.Table
   ( widget
@@ -8,34 +7,40 @@ module View.Payment.Table
   , TableOut(..)
   ) where
 
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.List as L
-import qualified Data.Map as M
-import Prelude hiding (init)
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.List          as L
+import qualified Data.Map           as M
+import           Data.Text          (Text)
+import qualified Data.Text          as T
+import           Prelude            hiding (init)
+import           Reflex.Dom         (MonadWidget, Dynamic)
+import qualified Reflex.Dom         as R
 
-import qualified Common.Message as Message
+import qualified Common.Message     as Message
 import qualified Common.Message.Key as Key
-import Common.Model (Payment(..), PaymentCategory(..), Category(..), User(..), Init(..))
-import qualified Common.Model as CM
-import qualified Common.Util.Text as T
+import           Common.Model       (Category (..), Init (..), Payment (..),
+                                     PaymentCategory (..), User (..))
+import qualified Common.Model       as CM
+import qualified Common.Util.Text   as T
 import qualified Common.View.Format as Format
 
 import qualified Icon
 
-data TableIn = TableIn
+data TableIn t = TableIn
   { _tableIn_init :: Init
+  , _tableIn_currentPage :: Dynamic t Int
   }
 
 data TableOut = TableOut
   {
   }
 
-widget :: forall t m. MonadWidget t m => TableIn -> m TableOut
+visiblePayments :: Int
+visiblePayments = 8
+
+widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut
 widget tableIn = do
-  R.divClass "table" $
+  R.dynText (fmap (T.pack . show) . _tableIn_currentPage $ tableIn)
+  _ <- R.divClass "table" $
     R.divClass "lines" $ do
       R.divClass "header" $ do
         R.divClass "cell name" $ R.text $ Message.get Key.Payment_Name
@@ -48,39 +53,50 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
       let init = _tableIn_init tableIn
           payments = _init_payments init
-      mapM_
-        (paymentRow init)
-        (take 8 . reverse . L.sortOn _payment_date $ payments)
+          paymentRange = fmap
+            (\p -> take visiblePayments . drop ((p - 1) * visiblePayments) . reverse . L.sortOn _payment_date $ payments)
+            (_tableIn_currentPage tableIn)
+      R.simpleList paymentRange (paymentRow init)
   return $ TableOut {}
 
-paymentRow :: forall t m. MonadWidget t m => Init -> Payment -> m ()
+paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
 paymentRow init payment =
   R.divClass "row" $ do
-    R.divClass "cell name" . R.text $ _payment_name payment
-    R.divClass "cell cost" . R.text . Format.price (_init_currency init) $ _payment_cost payment
+    R.divClass "cell name" . R.dynText . fmap _payment_name $ payment
+    R.divClass "cell cost" . R.dynText . fmap (Format.price (_init_currency init) . _payment_cost) $  payment
+
+    let user = flip fmap payment $ \p -> CM.findUser (_payment_user p) (_init_users init)
     R.divClass "cell user" $
-      case CM.findUser (_payment_user payment) (_init_users init) of
-        Just user -> R.text (_user_name user)
-        _ -> R.blank
-    R.divClass "cell category" $
-      case findCategory (_init_categories init) (_init_paymentCategories init) (_payment_name payment) of
-        Just category ->
-          R.elAttr "span" (M.fromList [("class", "tag"), ("style", T.concat [ "background-color: ", _category_color category ])]) $
-            R.text $ _category_name category
-        _ ->
-          R.blank
+      R.dynText $ flip fmap user $ \mbUser -> case mbUser of
+        Just u -> _user_name u
+        _         -> ""
+
+    let category = flip fmap payment $ \p -> findCategory
+          (_init_categories init)
+          (_init_paymentCategories init)
+          (_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 $ flip fmap category $ \mbCategory -> case mbCategory of
+          Just c -> _category_name c
+          _      -> ""
+
     R.divClass "cell date" $ do
-      R.elClass "span" "shortDate" . R.text $ Format.shortDay (_payment_date payment)
-      R.elClass "span" "longDate" . R.text $ Format.longDay (_payment_date 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
-    R.divClass "cell button" $
-      if _payment_user payment == (_init_currentUser init)
-        then R.el "button" $ Icon.edit
-        else R.blank
-    R.divClass "cell button" $
-      if _payment_user payment == (_init_currentUser init)
-        then R.el "button" $ Icon.delete
-        else R.blank
+    let modifyAttrs = flip fmap payment $ \p ->
+          M.fromList [("class", "cell button"), ("display", if _payment_user p == _init_currentUser init then "block" else "none")]
+    R.elDynAttr "div" modifyAttrs $
+      R.el "button" $ Icon.edit
+    R.elDynAttr "div" modifyAttrs $
+      R.el "button" $ Icon.delete
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
-- 
cgit v1.2.3


From 42e94a45e26f40edc3ad71b1e77a4bf47c13fd3d Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 15 Nov 2017 23:50:44 +0100
Subject: Add dynamic pages

---
 client/src/View/Payment/Constants.hs |  6 +++
 client/src/View/Payment/Pages.hs     | 71 +++++++++++++++++++++++-------------
 client/src/View/Payment/Table.hs     | 50 +++++++++++++------------
 3 files changed, 78 insertions(+), 49 deletions(-)
 create mode 100644 client/src/View/Payment/Constants.hs

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Constants.hs b/client/src/View/Payment/Constants.hs
new file mode 100644
index 0000000..ac2320a
--- /dev/null
+++ b/client/src/View/Payment/Constants.hs
@@ -0,0 +1,6 @@
+module View.Payment.Constants
+  ( paymentsPerPage
+  ) where
+
+paymentsPerPage :: Int
+paymentsPerPage = 8
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index cf3e115..f96cb8e 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -7,15 +7,17 @@ module View.Payment.Pages
   , PagesOut(..)
   ) where
 
-import qualified Data.Text    as T
-import           Reflex.Dom   (Event, Dynamic, 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           Common.Model (Payment (..))
+import           Common.Model           (Payment (..))
+
+import           Component              (ButtonIn (..), ButtonOut (..))
+import qualified Component              as Component
 
-import           Component    (ButtonIn (..), ButtonOut (..))
-import qualified Component    as Component
 import qualified Icon
+import qualified View.Payment.Constants as Constants
 
 data PagesIn = PagesIn
   { _pagesIn_payments :: [Payment]
@@ -26,26 +28,43 @@ data PagesOut t = PagesOut
   }
 
 widget :: forall t m. MonadWidget t m => PagesIn -> m (PagesOut t)
-widget _ = do
-  currentPage <- R.divClass "pages" $ do
-    a <- page 1 Icon.doubleLeftBar
-    b <- page 1 Icon.doubleLeft
-    c <- page 1 (R.text . T.pack . show $ (1 :: Integer))
-    d <- page 2 (R.text . T.pack . show $ (2 :: Integer))
-    e <- page 3 (R.text . T.pack . show $ (3 :: Integer))
-    f <- page 4 (R.text . T.pack . show $ (4 :: Integer))
-    g <- page 5 (R.text . T.pack . show $ (5 :: Integer))
-    h <- page 5 Icon.doubleRight
-    i <- page 5 Icon.doubleRightBar
-    R.holdDyn 1 $ R.leftmost [ a, b, c, d, e, f, g, h, i ]
-  return $ PagesOut
-    { _pagesOut_currentPage = currentPage
-    }
-
-page :: forall t m. MonadWidget t m => Int -> m () -> m (Event t Int)
-page n content =
-  ((fmap (const n)) . _buttonOut_clic) <$> (Component.button $ ButtonIn
-    { _buttonIn_class   = "page"
+widget pagesIn = do
+  R.divClass "pages" $ do
+    rec
+      currentPage <- R.holdDyn 1 . R.leftmost $ [ firstPageClic, previousPageClic, pageClic, nextPageClic, lastPageClic ]
+
+      firstPageClic <- pageButton (R.constDyn 0) (R.constDyn 1) Icon.doubleLeftBar
+
+      previousPageClic <- pageButton (R.constDyn 0) (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
+
+      pageClic <- pageEvent <$> (R.simpleList (fmap (range maxPage) currentPage) $ \p ->
+        pageButton currentPage p (R.dynText $ fmap (T.pack . show) p))
+
+      nextPageClic <- pageButton (R.constDyn 0) (fmap (\x -> min (x + 1) maxPage) currentPage) Icon.doubleRight
+
+      lastPageClic <- pageButton (R.constDyn 0) (R.constDyn maxPage) Icon.doubleRightBar
+
+    return $ PagesOut
+      { _pagesOut_currentPage = currentPage
+      }
+
+    where maxPage = ceiling $ (toRational . length . _pagesIn_payments $ pagesIn) / toRational Constants.paymentsPerPage
+          pageEvent = R.switchPromptlyDyn . fmap R.leftmost
+
+range :: Int -> Int -> [Int]
+range maxPage currentPage = [start..end]
+  where sidePages = 2
+        start = max 1 (currentPage - sidePages)
+        end = min maxPage (start + sidePages * 2)
+
+pageButton :: forall t m. MonadWidget t m => Dynamic t Int -> Dynamic t Int -> m () -> m (Event t Int)
+pageButton currentPage page content = do
+  clic <- _buttonOut_clic <$> (Component.button $ ButtonIn
+    { _buttonIn_class   = do
+        cp <- currentPage
+        p <- page
+        if cp == p then "page current" else "page"
     , _buttonIn_content = content
     , _buttonIn_waiting = R.never
     })
+  return . fmap fst $ R.attach (R.current page) clic
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 734511d..5c0b709 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -7,26 +7,27 @@ module View.Payment.Table
   , TableOut(..)
   ) where
 
-import qualified Data.List          as L
-import qualified Data.Map           as M
-import           Data.Text          (Text)
-import qualified Data.Text          as T
-import           Prelude            hiding (init)
-import           Reflex.Dom         (MonadWidget, Dynamic)
-import qualified Reflex.Dom         as R
+import qualified Data.List              as L
+import qualified Data.Map               as M
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import           Prelude                hiding (init)
+import           Reflex.Dom             (Dynamic, MonadWidget)
+import qualified Reflex.Dom             as R
 
-import qualified Common.Message     as Message
-import qualified Common.Message.Key as Key
-import           Common.Model       (Category (..), Init (..), Payment (..),
-                                     PaymentCategory (..), User (..))
-import qualified Common.Model       as CM
-import qualified Common.Util.Text   as T
-import qualified Common.View.Format as Format
+import qualified Common.Message         as Message
+import qualified Common.Message.Key     as Key
+import           Common.Model           (Category (..), Init (..), Payment (..),
+                                         PaymentCategory (..), User (..))
+import qualified Common.Model           as CM
+import qualified Common.Util.Text       as T
+import qualified Common.View.Format     as Format
 
 import qualified Icon
+import qualified View.Payment.Constants as Constants
 
 data TableIn t = TableIn
-  { _tableIn_init :: Init
+  { _tableIn_init        :: Init
   , _tableIn_currentPage :: Dynamic t Int
   }
 
@@ -34,12 +35,8 @@ data TableOut = TableOut
   {
   }
 
-visiblePayments :: Int
-visiblePayments = 8
-
 widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut
 widget tableIn = do
-  R.dynText (fmap (T.pack . show) . _tableIn_currentPage $ tableIn)
   _ <- R.divClass "table" $
     R.divClass "lines" $ do
       R.divClass "header" $ do
@@ -52,13 +49,20 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
       let init = _tableIn_init tableIn
+          currentPage = _tableIn_currentPage tableIn
           payments = _init_payments init
-          paymentRange = fmap
-            (\p -> take visiblePayments . drop ((p - 1) * visiblePayments) . reverse . L.sortOn _payment_date $ payments)
-            (_tableIn_currentPage tableIn)
+          paymentRange = fmap (getPaymentRange payments) currentPage
       R.simpleList paymentRange (paymentRow init)
   return $ TableOut {}
 
+getPaymentRange :: [Payment] -> Int -> [Payment]
+getPaymentRange payments currentPage =
+  take Constants.paymentsPerPage
+  . drop ((currentPage - 1) * Constants.paymentsPerPage)
+  . reverse
+  . L.sortOn _payment_date
+  $ payments
+
 paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
 paymentRow init payment =
   R.divClass "row" $ do
@@ -69,7 +73,7 @@ paymentRow init payment =
     R.divClass "cell user" $
       R.dynText $ flip fmap user $ \mbUser -> case mbUser of
         Just u -> _user_name u
-        _         -> ""
+        _      -> ""
 
     let category = flip fmap payment $ \p -> findCategory
           (_init_categories init)
-- 
cgit v1.2.3


From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 19 Nov 2017 00:20:25 +0100
Subject: Show payment count and partition

- Also fixes exceedingPayer in back by using only punctual payments
---
 client/src/View/Payment/Constants.hs |  2 +-
 client/src/View/Payment/Header.hs    | 70 ++++++++++++++++++++++++++++++++++++
 client/src/View/Payment/Pages.hs     |  8 ++---
 client/src/View/Payment/Table.hs     | 28 +++++++--------
 4 files changed, 87 insertions(+), 21 deletions(-)
 create mode 100644 client/src/View/Payment/Header.hs

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Constants.hs b/client/src/View/Payment/Constants.hs
index ac2320a..028e328 100644
--- a/client/src/View/Payment/Constants.hs
+++ b/client/src/View/Payment/Constants.hs
@@ -3,4 +3,4 @@ module View.Payment.Constants
   ) where
 
 paymentsPerPage :: Int
-paymentsPerPage = 8
+paymentsPerPage = 7
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
new file mode 100644
index 0000000..67b4eb4
--- /dev/null
+++ b/client/src/View/Payment/Header.hs
@@ -0,0 +1,70 @@
+module View.Payment.Header
+  ( widget
+  , HeaderIn(..)
+  , HeaderOut(..)
+  ) where
+
+import qualified Data.List          as L hiding (groupBy)
+import           Data.Maybe         (fromMaybe)
+import qualified Data.Text          as T
+import           Prelude            hiding (init)
+import           Reflex.Dom         (MonadWidget)
+import qualified Reflex.Dom         as R
+
+import           Common.Model       (Currency, Frequency (..), Init (..),
+                                     Payment (..), User (..), UserId)
+import qualified Common.Msg         as Msg
+import qualified Common.View.Format as Format
+
+import qualified Util.List          as L
+
+data HeaderIn t = HeaderIn
+  { _headerIn_init    :: Init
+  }
+
+data HeaderOut = HeaderOut
+  {
+  }
+
+widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut
+widget headerIn =
+  R.divClass "header" $ do
+    infos payments users currency
+    return $ HeaderOut {}
+  where init = _headerIn_init headerIn
+        payments = _init_payments init
+        users = _init_users init
+        currency = _init_currency init
+
+infos :: forall t m. MonadWidget t m => [Payment] -> [User] -> Currency -> m ()
+infos payments users currency =
+  R.divClass "infos" $ do
+    R.elClass "span" "total" $ do
+      R.text . Msg.get $ Msg.Payment_Worth
+        (T.intercalate " "
+          [ (Format.number paymentCount)
+          , if paymentCount > 1
+              then Msg.get Msg.Payment_Many
+              else Msg.get Msg.Payment_One
+          ])
+        (Format.price currency total)
+    R.elClass "span" "partition" . R.text $
+      T.intercalate ", "
+        . map (\(userId, userTotal) ->
+            Msg.get $ Msg.Payment_By
+              (fromMaybe "" . fmap _user_name . L.find ((==) userId . _user_id) $ users)
+              (Format.price currency userTotal)
+          )
+        $ totalByUser
+
+  where punctualPayments = filter ((==) Punctual . _payment_frequency) payments
+        paymentCount = length punctualPayments
+        total = sum . map _payment_cost $ punctualPayments
+
+        totalByUser :: [(UserId, Int)]
+        totalByUser =
+          L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
+            . map (\(u, xs) -> (u, sum . map snd $ xs))
+            . L.groupBy fst
+            . map (\p -> (_payment_user p, _payment_cost p))
+            $ punctualPayments
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index f96cb8e..81555ab 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo       #-}
-
 module View.Payment.Pages
   ( widget
   , PagesIn(..)
@@ -11,7 +8,7 @@ import qualified Data.Text              as T
 import           Reflex.Dom             (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Payment (..))
+import           Common.Model           (Frequency (..), Payment (..))
 
 import           Component              (ButtonIn (..), ButtonOut (..))
 import qualified Component              as Component
@@ -48,7 +45,8 @@ widget pagesIn = do
       { _pagesOut_currentPage = currentPage
       }
 
-    where maxPage = ceiling $ (toRational . length . _pagesIn_payments $ pagesIn) / toRational Constants.paymentsPerPage
+    where paymentCount = length . filter ((==) Punctual . _payment_frequency) . _pagesIn_payments $ pagesIn
+          maxPage = ceiling $ toRational paymentCount / toRational Constants.paymentsPerPage
           pageEvent = R.switchPromptlyDyn . fmap R.leftmost
 
 range :: Int -> Int -> [Int]
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 5c0b709..d8093a5 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo       #-}
-
 module View.Payment.Table
   ( widget
   , TableIn(..)
@@ -15,11 +12,11 @@ import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import qualified Common.Message         as Message
-import qualified Common.Message.Key     as Key
-import           Common.Model           (Category (..), Init (..), Payment (..),
+import           Common.Model           (Category (..), Frequency (..),
+                                         Init (..), Payment (..),
                                          PaymentCategory (..), User (..))
 import qualified Common.Model           as CM
+import qualified Common.Msg             as Msg
 import qualified Common.Util.Text       as T
 import qualified Common.View.Format     as Format
 
@@ -40,11 +37,11 @@ widget tableIn = do
   _ <- R.divClass "table" $
     R.divClass "lines" $ do
       R.divClass "header" $ do
-        R.divClass "cell name" $ R.text $ Message.get Key.Payment_Name
-        R.divClass "cell cost" $ R.text $ Message.get Key.Payment_Cost
-        R.divClass "cell user" $ R.text $ Message.get Key.Payment_User
-        R.divClass "cell category" $ R.text $ Message.get Key.Payment_Category
-        R.divClass "cell date" $ R.text $ Message.get Key.Payment_Date
+        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
@@ -58,10 +55,11 @@ widget tableIn = do
 getPaymentRange :: [Payment] -> Int -> [Payment]
 getPaymentRange payments currentPage =
   take Constants.paymentsPerPage
-  . drop ((currentPage - 1) * Constants.paymentsPerPage)
-  . reverse
-  . L.sortOn _payment_date
-  $ payments
+    . drop ((currentPage - 1) * Constants.paymentsPerPage)
+    . reverse
+    . L.sortOn _payment_date
+    . filter ((==) Punctual . _payment_frequency)
+    $ payments
 
 paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
 paymentRow init payment =
-- 
cgit v1.2.3


From bab2c30addf8aaed85675e2b7f7b15c97c426f74 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 19 Nov 2017 15:00:07 +0100
Subject: Add exceeding payer block

---
 client/src/View/Payment/Header.hs | 66 ++++++++++++++++++++++++++++-----------
 1 file changed, 48 insertions(+), 18 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 67b4eb4..3f2adc3 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -4,22 +4,29 @@ module View.Payment.Header
   , HeaderOut(..)
   ) where
 
-import qualified Data.List          as L hiding (groupBy)
-import           Data.Maybe         (fromMaybe)
-import qualified Data.Text          as T
-import           Prelude            hiding (init)
-import           Reflex.Dom         (MonadWidget)
-import qualified Reflex.Dom         as R
+import           Control.Monad          (forM_)
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.List              as L hiding (groupBy)
+import           Data.Maybe             (fromMaybe)
+import qualified Data.Text              as T
+import qualified Data.Time              as Time
+import           Prelude                hiding (init)
+import           Reflex.Dom             (MonadWidget)
+import qualified Reflex.Dom             as R
 
-import           Common.Model       (Currency, Frequency (..), Init (..),
-                                     Payment (..), User (..), UserId)
-import qualified Common.Msg         as Msg
-import qualified Common.View.Format as Format
+import           Common.Model           (Currency, ExceedingPayer (..),
+                                         Frequency (..), Income (..), Init (..),
+                                         Payment (..), User (..), UserId)
+import qualified Common.Model           as CM
+import qualified Common.Msg             as Msg
+import qualified Common.View.Format     as Format
 
-import qualified Util.List          as L
+import           Component              (ButtonIn (..))
+import qualified Component              as Component
+import qualified Util.List              as L
 
 data HeaderIn t = HeaderIn
-  { _headerIn_init    :: Init
+  { _headerIn_init :: Init
   }
 
 data HeaderOut = HeaderOut
@@ -29,13 +36,37 @@ data HeaderOut = HeaderOut
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut
 widget headerIn =
   R.divClass "header" $ do
+    payerAndAdd incomes payments users currency
     infos payments users currency
     return $ HeaderOut {}
   where init = _headerIn_init headerIn
-        payments = _init_payments init
+        incomes = _init_incomes init
+        payments = filter ((==) Punctual . _payment_frequency) (_init_payments init)
         users = _init_users init
         currency = _init_currency init
 
+payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> Currency -> m ()
+payerAndAdd incomes payments users currency = do
+  time <- liftIO Time.getCurrentTime
+  R.divClass "payerAndAdd" $ do
+    R.divClass "exceedingPayers" $
+      forM_
+        (CM.getExceedingPayers time users incomes payments)
+        (\p ->
+          R.elClass "span" "exceedingPayer" $ do
+            R.elClass "span" "userName" $
+              R.text . fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId p) users
+            R.elClass "span" "amount" $ do
+              R.text "+ "
+              R.text . Format.price currency $ _exceedingPayer_amount p
+        )
+    _ <- Component.button $ ButtonIn
+      { _buttonIn_class = R.constDyn "addPayment"
+      , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
+      , _buttonIn_waiting = R.never
+      }
+    return ()
+
 infos :: forall t m. MonadWidget t m => [Payment] -> [User] -> Currency -> m ()
 infos payments users currency =
   R.divClass "infos" $ do
@@ -52,14 +83,13 @@ infos payments users currency =
       T.intercalate ", "
         . map (\(userId, userTotal) ->
             Msg.get $ Msg.Payment_By
-              (fromMaybe "" . fmap _user_name . L.find ((==) userId . _user_id) $ users)
+              (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
               (Format.price currency userTotal)
           )
         $ totalByUser
 
-  where punctualPayments = filter ((==) Punctual . _payment_frequency) payments
-        paymentCount = length punctualPayments
-        total = sum . map _payment_cost $ punctualPayments
+  where paymentCount = length payments
+        total = sum . map _payment_cost $ payments
 
         totalByUser :: [(UserId, Int)]
         totalByUser =
@@ -67,4 +97,4 @@ infos payments users currency =
             . map (\(u, xs) -> (u, sum . map snd $ xs))
             . L.groupBy fst
             . map (\p -> (_payment_user p, _payment_cost p))
-            $ punctualPayments
+            $ payments
-- 
cgit v1.2.3


From 49426740e8e0c59040f4f3721a658f225572582b Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 28 Nov 2017 09:11:19 +0100
Subject: Add search for payments

---
 client/src/View/Payment/Header.hs | 25 +++++++++++++++++++------
 client/src/View/Payment/Pages.hs  | 37 +++++++++++++++++++++----------------
 client/src/View/Payment/Table.hs  |  9 ++++-----
 3 files changed, 44 insertions(+), 27 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 3f2adc3..f64f11d 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -8,10 +8,11 @@ import           Control.Monad          (forM_)
 import           Control.Monad.IO.Class (liftIO)
 import qualified Data.List              as L hiding (groupBy)
 import           Data.Maybe             (fromMaybe)
+import           Data.Text              (Text)
 import qualified Data.Text              as T
 import qualified Data.Time              as Time
 import           Prelude                hiding (init)
-import           Reflex.Dom             (MonadWidget)
+import           Reflex.Dom             (Dynamic, MonadWidget)
 import qualified Reflex.Dom             as R
 
 import           Common.Model           (Currency, ExceedingPayer (..),
@@ -21,7 +22,8 @@ import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.View.Format     as Format
 
-import           Component              (ButtonIn (..))
+import           Component              (ButtonIn (..), InputIn (..),
+                                         InputOut (..))
 import qualified Component              as Component
 import qualified Util.List              as L
 
@@ -29,16 +31,19 @@ data HeaderIn t = HeaderIn
   { _headerIn_init :: Init
   }
 
-data HeaderOut = HeaderOut
-  {
+data HeaderOut t = HeaderOut
+  { _headerOut_search :: Dynamic t Text
   }
 
-widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut
+widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
     payerAndAdd incomes payments users currency
+    search <- searchLine
     infos payments users currency
-    return $ HeaderOut {}
+    return $ HeaderOut
+      { _headerOut_search = search
+      }
   where init = _headerIn_init headerIn
         incomes = _init_incomes init
         payments = filter ((==) Punctual . _payment_frequency) (_init_payments init)
@@ -98,3 +103,11 @@ infos payments users currency =
             . L.groupBy fst
             . map (\p -> (_payment_user p, _payment_cost p))
             $ payments
+
+searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text)
+searchLine =
+  R.divClass "searchLine" $
+    _inputOut_value <$> (Component.input $ InputIn
+      { _inputIn_reset = R.never
+      , _inputIn_label = Msg.get Msg.Search_Name
+      })
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 81555ab..dfd92c0 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -8,7 +8,7 @@ import qualified Data.Text              as T
 import           Reflex.Dom             (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Frequency (..), Payment (..))
+import           Common.Model           (Payment (..))
 
 import           Component              (ButtonIn (..), ButtonOut (..))
 import qualified Component              as Component
@@ -16,52 +16,57 @@ import qualified Component              as Component
 import qualified Icon
 import qualified View.Payment.Constants as Constants
 
-data PagesIn = PagesIn
-  { _pagesIn_payments :: [Payment]
+data PagesIn t = PagesIn
+  { _pagesIn_payments :: Dynamic t [Payment]
   }
 
 data PagesOut t = PagesOut
   { _pagesOut_currentPage :: Dynamic t Int
   }
 
-widget :: forall t m. MonadWidget t m => PagesIn -> m (PagesOut t)
+widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
 widget pagesIn = do
   R.divClass "pages" $ do
     rec
       currentPage <- R.holdDyn 1 . R.leftmost $ [ firstPageClic, previousPageClic, pageClic, nextPageClic, lastPageClic ]
 
-      firstPageClic <- pageButton (R.constDyn 0) (R.constDyn 1) Icon.doubleLeftBar
+      firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
 
-      previousPageClic <- pageButton (R.constDyn 0) (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
+      previousPageClic <- pageButton noCurrentPage (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
 
-      pageClic <- pageEvent <$> (R.simpleList (fmap (range maxPage) currentPage) $ \p ->
-        pageButton currentPage p (R.dynText $ fmap (T.pack . show) p))
+      pageClic <- pageEvent <$> (R.simpleList (range <$> currentPage <*> maxPage) $ \p ->
+        pageButton (Just <$> currentPage) p (R.dynText $ fmap (T.pack . show) p))
 
-      nextPageClic <- pageButton (R.constDyn 0) (fmap (\x -> min (x + 1) maxPage) currentPage) Icon.doubleRight
+      nextPageClic <- pageButton noCurrentPage ((\c m -> min (c + 1) m) <$> currentPage <*> maxPage) Icon.doubleRight
 
-      lastPageClic <- pageButton (R.constDyn 0) (R.constDyn maxPage) Icon.doubleRightBar
+      lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
 
     return $ PagesOut
       { _pagesOut_currentPage = currentPage
       }
 
-    where paymentCount = length . filter ((==) Punctual . _payment_frequency) . _pagesIn_payments $ pagesIn
-          maxPage = ceiling $ toRational paymentCount / toRational Constants.paymentsPerPage
+    where maxPage =
+            R.ffor (_pagesIn_payments pagesIn) (\payments ->
+              ceiling $ toRational (length payments) / toRational Constants.paymentsPerPage
+            )
+
           pageEvent = R.switchPromptlyDyn . fmap R.leftmost
 
+          noCurrentPage = R.constDyn Nothing
+
 range :: Int -> Int -> [Int]
-range maxPage currentPage = [start..end]
+range currentPage maxPage = [start..end]
   where sidePages = 2
-        start = max 1 (currentPage - sidePages)
+        start = max 1 (min (currentPage - sidePages) (maxPage - sidePages * 2))
         end = min maxPage (start + sidePages * 2)
 
-pageButton :: forall t m. MonadWidget t m => Dynamic t Int -> Dynamic t Int -> m () -> m (Event t Int)
+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 <- _buttonOut_clic <$> (Component.button $ ButtonIn
     { _buttonIn_class   = do
         cp <- currentPage
         p <- page
-        if cp == p then "page current" else "page"
+        if cp == Just p then "page current" else "page"
     , _buttonIn_content = content
     , _buttonIn_waiting = R.never
     })
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index d8093a5..0c3b769 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -12,8 +12,7 @@ import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Category (..), Frequency (..),
-                                         Init (..), Payment (..),
+import           Common.Model           (Category (..), Init (..), Payment (..),
                                          PaymentCategory (..), User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
@@ -26,6 +25,7 @@ import qualified View.Payment.Constants as Constants
 data TableIn t = TableIn
   { _tableIn_init        :: Init
   , _tableIn_currentPage :: Dynamic t Int
+  , _tableIn_payments    :: Dynamic t [Payment]
   }
 
 data TableOut = TableOut
@@ -47,8 +47,8 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
       let init = _tableIn_init tableIn
           currentPage = _tableIn_currentPage tableIn
-          payments = _init_payments init
-          paymentRange = fmap (getPaymentRange payments) currentPage
+          payments = _tableIn_payments tableIn
+          paymentRange = getPaymentRange <$> payments <*> currentPage
       R.simpleList paymentRange (paymentRow init)
   return $ TableOut {}
 
@@ -58,7 +58,6 @@ getPaymentRange payments currentPage =
     . drop ((currentPage - 1) * Constants.paymentsPerPage)
     . reverse
     . L.sortOn _payment_date
-    . filter ((==) Punctual . _payment_frequency)
     $ payments
 
 paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
-- 
cgit v1.2.3


From a4acc2e84158fa822f88a1d0bdddb470708b5809 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 3 Jan 2018 17:31:20 +0100
Subject: Modify weelky report and payment search interface

- Add payment balance in weekly report
- Show a message and hide pages when the search results in no results
- Go to page 1 when the search is updated / erased
---
 client/src/View/Payment/Constants.hs |  6 ----
 client/src/View/Payment/Pages.hs     | 51 +++++++++++++++++++------------
 client/src/View/Payment/Table.hs     | 59 +++++++++++++++++++++---------------
 3 files changed, 66 insertions(+), 50 deletions(-)
 delete mode 100644 client/src/View/Payment/Constants.hs

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Constants.hs b/client/src/View/Payment/Constants.hs
deleted file mode 100644
index 028e328..0000000
--- a/client/src/View/Payment/Constants.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module View.Payment.Constants
-  ( paymentsPerPage
-  ) where
-
-paymentsPerPage :: Int
-paymentsPerPage = 7
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index dfd92c0..55ceb9f 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -4,20 +4,20 @@ 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           Common.Model           (Payment (..))
-
-import           Component              (ButtonIn (..), ButtonOut (..))
-import qualified Component              as Component
+import           Component  (ButtonIn (..), ButtonOut (..))
+import qualified Component  as Component
 
 import qualified Icon
-import qualified View.Payment.Constants as Constants
+import qualified Util.Dom   as Dom
 
 data PagesIn t = PagesIn
-  { _pagesIn_payments :: Dynamic t [Payment]
+  { _pagesIn_total   :: Dynamic t Int
+  , _pagesIn_perPage :: Int
+  , _pagesIn_reset   :: Event t ()
   }
 
 data PagesOut t = PagesOut
@@ -26,9 +26,29 @@ 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
+
+  return $ PagesOut
+    { _pagesOut_currentPage = currentPage
+    }
+
+  where
+    total = _pagesIn_total pagesIn
+    perPage = _pagesIn_perPage pagesIn
+    reset = _pagesIn_reset pagesIn
+
+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 ]
+      currentPage <- R.holdDyn 1 . R.leftmost $
+        [ firstPageClic
+        , previousPageClic
+        , pageClic
+        , nextPageClic
+        , lastPageClic
+        , (const 1) <$> reset
+        ]
 
       firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
 
@@ -41,17 +61,10 @@ widget pagesIn = do
 
       lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
 
-    return $ PagesOut
-      { _pagesOut_currentPage = currentPage
-      }
-
-    where maxPage =
-            R.ffor (_pagesIn_payments pagesIn) (\payments ->
-              ceiling $ toRational (length payments) / toRational Constants.paymentsPerPage
-            )
+    return currentPage
 
+    where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
           pageEvent = R.switchPromptlyDyn . fmap R.leftmost
-
           noCurrentPage = R.constDyn Nothing
 
 range :: Int -> Int -> [Int]
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 0c3b769..a49be5c 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -4,28 +4,29 @@ module View.Payment.Table
   , TableOut(..)
   ) where
 
-import qualified Data.List              as L
-import qualified Data.Map               as M
-import           Data.Text              (Text)
-import qualified Data.Text              as T
-import           Prelude                hiding (init)
-import           Reflex.Dom             (Dynamic, MonadWidget)
-import qualified Reflex.Dom             as R
-
-import           Common.Model           (Category (..), Init (..), Payment (..),
-                                         PaymentCategory (..), User (..))
-import qualified Common.Model           as CM
-import qualified Common.Msg             as Msg
-import qualified Common.Util.Text       as T
-import qualified Common.View.Format     as Format
+import qualified Data.List          as L
+import qualified Data.Map           as M
+import           Data.Text          (Text)
+import qualified Data.Text          as T
+import           Prelude            hiding (init)
+import           Reflex.Dom         (Dynamic, MonadWidget)
+import qualified Reflex.Dom         as R
+
+import           Common.Model       (Category (..), Init (..), Payment (..),
+                                     PaymentCategory (..), User (..))
+import qualified Common.Model       as CM
+import qualified Common.Msg         as Msg
+import qualified Common.Util.Text   as T
+import qualified Common.View.Format as Format
 
 import qualified Icon
-import qualified View.Payment.Constants as Constants
+import qualified Util.Dom           as Dom
 
 data TableIn t = TableIn
   { _tableIn_init        :: Init
   , _tableIn_currentPage :: Dynamic t Int
   , _tableIn_payments    :: Dynamic t [Payment]
+  , _tableIn_perPage     :: Int
   }
 
 data TableOut = TableOut
@@ -34,7 +35,8 @@ data TableOut = TableOut
 
 widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut
 widget tableIn = do
-  _ <- R.divClass "table" $
+  R.divClass "table" $ do
+
     R.divClass "lines" $ do
       R.divClass "header" $ do
         R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
@@ -45,17 +47,24 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
-      let init = _tableIn_init tableIn
-          currentPage = _tableIn_currentPage tableIn
-          payments = _tableIn_payments tableIn
-          paymentRange = getPaymentRange <$> payments <*> currentPage
-      R.simpleList paymentRange (paymentRow init)
+      _ <- R.simpleList paymentRange (paymentRow init)
+      return ()
+
+    Dom.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
+      R.text $ Msg.get Msg.Payment_Empty
+
   return $ TableOut {}
 
-getPaymentRange :: [Payment] -> Int -> [Payment]
-getPaymentRange payments currentPage =
-  take Constants.paymentsPerPage
-    . drop ((currentPage - 1) * Constants.paymentsPerPage)
+  where
+    init = _tableIn_init tableIn
+    currentPage = _tableIn_currentPage tableIn
+    payments = _tableIn_payments tableIn
+    paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage
+
+getPaymentRange :: Int -> [Payment] -> Int -> [Payment]
+getPaymentRange perPage payments currentPage =
+  take perPage
+    . drop ((currentPage - 1) * perPage)
     . reverse
     . L.sortOn _payment_date
     $ payments
-- 
cgit v1.2.3


From ab17b6339d16970c3845ec4f153bfeed89eae728 Mon Sep 17 00:00:00 2001
From: Joris
Date: Fri, 5 Jan 2018 14:45:47 +0100
Subject: Add modal component

---
 client/src/View/Payment/Header.hs | 130 +++++++++++++++++++++++---------------
 1 file changed, 80 insertions(+), 50 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index f64f11d..a694136 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -7,23 +7,26 @@ module View.Payment.Header
 import           Control.Monad          (forM_)
 import           Control.Monad.IO.Class (liftIO)
 import qualified Data.List              as L hiding (groupBy)
+import qualified Data.Map               as M
 import           Data.Maybe             (fromMaybe)
 import           Data.Text              (Text)
 import qualified Data.Text              as T
 import qualified Data.Time              as Time
 import           Prelude                hiding (init)
-import           Reflex.Dom             (Dynamic, MonadWidget)
+import           Reflex.Dom             (Dynamic, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
 
 import           Common.Model           (Currency, ExceedingPayer (..),
                                          Frequency (..), Income (..), Init (..),
-                                         Payment (..), User (..), UserId)
+                                         Payment (..), User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
+import qualified Common.Util.Text       as T
 import qualified Common.View.Format     as Format
 
-import           Component              (ButtonIn (..), InputIn (..),
-                                         InputOut (..))
+import           Component              (ButtonIn (..), ButtonOut (..),
+                                         InputIn (..), InputOut (..),
+                                         ModalIn (..))
 import qualified Component              as Component
 import qualified Util.List              as L
 
@@ -32,23 +35,37 @@ data HeaderIn t = HeaderIn
   }
 
 data HeaderOut t = HeaderOut
-  { _headerOut_search :: Dynamic t Text
+  { _headerOut_searchName     :: Dynamic t Text
+  , _headerOut_searchPayments :: Dynamic t [Payment]
   }
 
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
-    payerAndAdd incomes payments users currency
-    search <- searchLine
-    infos payments users currency
+    payerAndAdd incomes punctualPayments users currency
+    (searchName, searchFrequency)  <- searchLine
+    let searchPayments = getSearchPayments searchName searchFrequency payments
+    infos searchPayments users currency
     return $ HeaderOut
-      { _headerOut_search = search
+      { _headerOut_searchName = searchName
+      , _headerOut_searchPayments = searchPayments
       }
-  where init = _headerIn_init headerIn
-        incomes = _init_incomes init
-        payments = filter ((==) Punctual . _payment_frequency) (_init_payments init)
-        users = _init_users init
-        currency = _init_currency init
+  where
+    init = _headerIn_init headerIn
+    incomes = _init_incomes init
+    payments = _init_payments init
+    punctualPayments = filter ((==) Punctual . _payment_frequency) payments
+    users = _init_users init
+    currency = _init_currency init
+
+getSearchPayments :: forall t. (Reflex t) => Dynamic t Text -> Dynamic t Frequency -> [Payment] -> Dynamic t [Payment]
+getSearchPayments name frequency payments = do
+  n <- name
+  f <- frequency
+  pure $ flip filter payments (\p ->
+    (  T.search n (_payment_name p)
+    && (_payment_frequency p == f)
+    ))
 
 payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> Currency -> m ()
 payerAndAdd incomes payments users currency = do
@@ -65,49 +82,62 @@ payerAndAdd incomes payments users currency = do
               R.text "+ "
               R.text . Format.price currency $ _exceedingPayer_amount p
         )
-    _ <- Component.button $ ButtonIn
+    addPayment <- _buttonOut_clic <$> (Component.button $ ButtonIn
       { _buttonIn_class = R.constDyn "addPayment"
       , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
       , _buttonIn_waiting = R.never
+      })
+    _ <- Component.modal $ ModalIn
+      { _modalIn_show    = addPayment
+      , _modalIn_content = R.el "h1" $ R.text "Ajouter un paiement"
       }
     return ()
 
-infos :: forall t m. MonadWidget t m => [Payment] -> [User] -> Currency -> m ()
+searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text, Dynamic t Frequency)
+searchLine = do
+  R.divClass "searchLine" $ do
+    searchName <- _inputOut_value <$> (Component.input $ InputIn
+      { _inputIn_reset = R.never
+      , _inputIn_label = Msg.get Msg.Search_Name
+      })
+
+    let frequencies = M.fromList
+          [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+          , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+          ]
+
+    searchFrequency <- R._dropdown_value <$>
+      R.dropdown Punctual (R.constDyn frequencies) R.def
+
+    return (searchName, searchFrequency)
+
+infos :: forall t m. MonadWidget t m => Dynamic t [Payment] -> [User] -> Currency -> m ()
 infos payments users currency =
   R.divClass "infos" $ do
-    R.elClass "span" "total" $ do
-      R.text . Msg.get $ Msg.Payment_Worth
-        (T.intercalate " "
-          [ (Format.number paymentCount)
-          , if paymentCount > 1
-              then Msg.get Msg.Payment_Many
-              else Msg.get Msg.Payment_One
-          ])
-        (Format.price currency total)
-    R.elClass "span" "partition" . R.text $
-      T.intercalate ", "
-        . map (\(userId, userTotal) ->
-            Msg.get $ Msg.Payment_By
-              (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
-              (Format.price currency userTotal)
-          )
-        $ totalByUser
 
-  where paymentCount = length payments
-        total = sum . map _payment_cost $ payments
-
-        totalByUser :: [(UserId, Int)]
-        totalByUser =
-          L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
-            . map (\(u, xs) -> (u, sum . map snd $ xs))
-            . L.groupBy fst
-            . map (\p -> (_payment_user p, _payment_cost p))
-            $ payments
+    R.elClass "span" "total" $ do
+      R.dynText $ do
+        ps <- payments
+        let paymentCount = length ps
+            total = sum . map _payment_cost $ ps
+        pure . Msg.get $ Msg.Payment_Worth
+          (T.intercalate " "
+            [ (Format.number paymentCount)
+            , if paymentCount > 1
+                then Msg.get Msg.Payment_Many
+                else Msg.get Msg.Payment_One
+            ])
+          (Format.price currency total)
 
-searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text)
-searchLine =
-  R.divClass "searchLine" $
-    _inputOut_value <$> (Component.input $ InputIn
-      { _inputIn_reset = R.never
-      , _inputIn_label = Msg.get Msg.Search_Name
-      })
+    R.elClass "span" "partition" . R.dynText $ do
+      ps <- payments
+      let totalByUser =
+            L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
+              . map (\(u, xs) -> (u, sum . map snd $ xs))
+              . L.groupBy fst
+              . map (\p -> (_payment_user p, _payment_cost p))
+              $ ps
+      pure . T.intercalate ", " . flip map totalByUser $ \(userId, userTotal) ->
+        Msg.get $ Msg.Payment_By
+          (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
+          (Format.price currency userTotal)
-- 
cgit v1.2.3


From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 28 Jan 2018 12:13:09 +0100
Subject: WIP

---
 client/src/View/Payment/Add.hs    | 104 ++++++++++++++++++++++++++++++++++++++
 client/src/View/Payment/Delete.hs |  51 +++++++++++++++++++
 client/src/View/Payment/Header.hs |  33 +++++++-----
 client/src/View/Payment/Pages.hs  |   2 +
 client/src/View/Payment/Table.hs  |  48 +++++++++++-------
 5 files changed, 209 insertions(+), 29 deletions(-)
 create mode 100644 client/src/View/Payment/Add.hs
 create mode 100644 client/src/View/Payment/Delete.hs

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
new file mode 100644
index 0000000..2eaec0f
--- /dev/null
+++ b/client/src/View/Payment/Add.hs
@@ -0,0 +1,104 @@
+module View.Payment.Add
+  ( view
+  , AddIn(..)
+  , AddOut(..)
+  ) where
+
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Map               as M
+import qualified Data.Maybe             as Maybe
+import qualified Data.Text              as T
+import qualified Data.Time.Clock        as Time
+import           Reflex.Dom             (Event, MonadWidget)
+import qualified Reflex.Dom             as R
+import qualified Text.Read              as T
+
+import           Common.Model           (Category (..), CreatePayment (..),
+                                         Frequency (..))
+import qualified Common.Msg             as Msg
+import qualified Common.Util.Time       as Time
+import qualified Common.View.Format     as Format
+import           Component              (ButtonIn (..), InputIn (..),
+                                         InputOut (..), SelectIn (..),
+                                         SelectOut (..))
+import qualified Component              as Component
+import qualified Util.Ajax              as Ajax
+import qualified Util.WaitFor           as Util
+
+data AddIn = AddIn
+  { _addIn_categories :: [Category]
+  }
+
+data AddOut t = AddOut
+  { _addOut_cancel :: Event t ()
+  }
+
+view :: forall t m. MonadWidget t m => AddIn -> m (AddOut t)
+view addIn = do
+  R.divClass "add" $ do
+    R.divClass "addHeader" $ R.text $ Msg.get Msg.Payment_Add
+
+    R.divClass "addContent" $ do
+      name <- _inputOut_value <$> (Component.input $
+        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+
+      cost <- _inputOut_value <$> (Component.input $
+        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+
+      currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+
+      date <- _inputOut_value <$> (Component.input $
+        Component.defaultInputIn
+          { _inputIn_label = Msg.get Msg.Payment_Cost
+          , _inputIn_initialValue = Format.shortDay currentDay
+          })
+
+      frequency <- _selectOut_value <$> (Component.select $ SelectIn
+        { _selectIn_label = Msg.get Msg.Payment_Frequency
+        , _selectIn_initialValue = Punctual
+        , _selectIn_values = R.constDyn frequencies
+        })
+
+      category <- _selectOut_value <$> (Component.select $ SelectIn
+        { _selectIn_label = Msg.get Msg.Payment_Category
+        , _selectIn_initialValue = 0
+        , _selectIn_values = R.constDyn categories
+        })
+
+      let payment = CreatePayment
+            <$> name
+            <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
+            <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
+            <*> category
+            <*> frequency
+
+      cancel <- R.divClass "buttons" $ do
+        rec
+          validate <- 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
+              })
+
+          (_, waiting) <- Util.waitFor
+            (Ajax.post "/payment")
+            validate
+            payment
+
+        Component._buttonOut_clic <$> (Component.button $
+          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+            { _buttonIn_class = R.constDyn "undo" })
+
+      return AddOut
+        { _addOut_cancel = cancel
+        }
+
+  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)
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
new file mode 100644
index 0000000..a1be16d
--- /dev/null
+++ b/client/src/View/Payment/Delete.hs
@@ -0,0 +1,51 @@
+module View.Payment.Delete
+  ( view
+  , DeleteIn(..)
+  , DeleteOut(..)
+  ) where
+
+import           Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+import qualified Common.Msg as Msg
+import           Component  (ButtonIn (..), ButtonOut (..))
+import qualified Component  as Component
+-- import qualified Util.Ajax              as Ajax
+-- import qualified Util.WaitFor           as Util
+
+data DeleteIn = DeleteIn
+  {}
+
+data DeleteOut t = DeleteOut
+  { _deleteOut_cancel :: Event t ()
+  }
+
+view :: forall t m. MonadWidget t m => DeleteIn -> m (DeleteOut t)
+view _ =
+  R.divClass "delete" $ do
+    R.divClass "deleteHeader" $ R.text $ Msg.get Msg.Payment_DeleteConfirm
+
+    R.divClass "deleteContent" $ do
+
+      cancel <- R.divClass "buttons" $ do
+        rec
+          _ <- Component._buttonOut_clic <$> (Component.button $
+            (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
+              { _buttonIn_class = R.constDyn "confirm"
+              , _buttonIn_submit = True
+              })
+
+          -- (_, waiting) <- Util.waitFor
+          --   (Ajax.post "/payment")
+          --   validate
+          --   payment
+
+        cancel <- Component._buttonOut_clic <$> (Component.button $
+          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+            { _buttonIn_class = R.constDyn "undo" })
+
+        return cancel
+
+      return DeleteOut
+        { _deleteOut_cancel = cancel
+        }
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index a694136..d01dec6 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -16,9 +16,10 @@ import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Currency, ExceedingPayer (..),
-                                         Frequency (..), Income (..), Init (..),
-                                         Payment (..), User (..))
+import           Common.Model           (Category, Currency,
+                                         ExceedingPayer (..), Frequency (..),
+                                         Income (..), Init (..), Payment (..),
+                                         User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.Util.Text       as T
@@ -26,9 +27,11 @@ import qualified Common.View.Format     as Format
 
 import           Component              (ButtonIn (..), ButtonOut (..),
                                          InputIn (..), InputOut (..),
-                                         ModalIn (..))
+                                         ModalIn (..), ModalOut (..))
 import qualified Component              as Component
 import qualified Util.List              as L
+import           View.Payment.Add       (AddIn (..), AddOut (..))
+import qualified View.Payment.Add       as Add
 
 data HeaderIn t = HeaderIn
   { _headerIn_init :: Init
@@ -42,7 +45,7 @@ data HeaderOut t = HeaderOut
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
-    payerAndAdd incomes punctualPayments users currency
+    payerAndAdd incomes punctualPayments users categories currency
     (searchName, searchFrequency)  <- searchLine
     let searchPayments = getSearchPayments searchName searchFrequency payments
     infos searchPayments users currency
@@ -56,6 +59,7 @@ widget headerIn =
     payments = _init_payments init
     punctualPayments = filter ((==) Punctual . _payment_frequency) payments
     users = _init_users init
+    categories = _init_categories init
     currency = _init_currency init
 
 getSearchPayments :: forall t. (Reflex t) => Dynamic t Text -> Dynamic t Frequency -> [Payment] -> Dynamic t [Payment]
@@ -63,12 +67,12 @@ getSearchPayments name frequency payments = do
   n <- name
   f <- frequency
   pure $ flip filter payments (\p ->
-    (  T.search n (_payment_name p)
+    (  (T.search n (_payment_name p) || T.search n (T.pack . show . _payment_cost $ p))
     && (_payment_frequency p == f)
     ))
 
-payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> Currency -> m ()
-payerAndAdd incomes payments users currency = do
+payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> [Category] -> Currency -> m ()
+payerAndAdd incomes payments users categories currency = do
   time <- liftIO Time.getCurrentTime
   R.divClass "payerAndAdd" $ do
     R.divClass "exceedingPayers" $
@@ -86,11 +90,15 @@ payerAndAdd incomes payments users currency = do
       { _buttonIn_class = R.constDyn "addPayment"
       , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
       , _buttonIn_waiting = R.never
+      , _buttonIn_tabIndex = Nothing
+      , _buttonIn_submit = False
       })
-    _ <- Component.modal $ ModalIn
-      { _modalIn_show    = addPayment
-      , _modalIn_content = R.el "h1" $ R.text "Ajouter un paiement"
-      }
+    rec
+      modalOut <- Component.modal $ ModalIn
+        { _modalIn_show    = addPayment
+        , _modalIn_hide = _addOut_cancel . _modalOut_content $ modalOut
+        , _modalIn_content = Add.view $ AddIn { _addIn_categories = categories }
+        }
     return ()
 
 searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text, Dynamic t Frequency)
@@ -99,6 +107,7 @@ searchLine = do
     searchName <- _inputOut_value <$> (Component.input $ InputIn
       { _inputIn_reset = R.never
       , _inputIn_label = Msg.get Msg.Search_Name
+      , _inputIn_initialValue = ""
       })
 
     let frequencies = M.fromList
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 55ceb9f..d14b640 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -82,5 +82,7 @@ pageButton currentPage page content = do
         if cp == Just p then "page current" else "page"
     , _buttonIn_content = content
     , _buttonIn_waiting = R.never
+    , _buttonIn_tabIndex = Nothing
+    , _buttonIn_submit = False
     })
   return . fmap fst $ R.attach (R.current page) clic
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index a49be5c..23d7225 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -4,23 +4,28 @@ module View.Payment.Table
   , TableOut(..)
   ) where
 
-import qualified Data.List          as L
-import qualified Data.Map           as M
-import           Data.Text          (Text)
-import qualified Data.Text          as T
-import           Prelude            hiding (init)
-import           Reflex.Dom         (Dynamic, MonadWidget)
-import qualified Reflex.Dom         as R
-
-import           Common.Model       (Category (..), Init (..), Payment (..),
-                                     PaymentCategory (..), User (..))
-import qualified Common.Model       as CM
-import qualified Common.Msg         as Msg
-import qualified Common.Util.Text   as T
-import qualified Common.View.Format as Format
+import qualified Data.List           as L
+import qualified Data.Map            as M
+import           Data.Text           (Text)
+import qualified Data.Text           as T
+import           Prelude             hiding (init)
+import           Reflex.Dom          (Dynamic, MonadWidget)
+import qualified Reflex.Dom          as R
+
+import           Common.Model        (Category (..), Init (..), Payment (..),
+                                      PaymentCategory (..), User (..))
+import qualified Common.Model        as CM
+import qualified Common.Msg          as Msg
+import qualified Common.Util.Text    as T
+import qualified Common.View.Format  as Format
+import           Component           (ButtonIn (..), ButtonOut (..),
+                                      ModalIn (..), ModalOut (..))
+import qualified Component           as Component
+import           View.Payment.Delete (DeleteIn (..), DeleteOut (..))
+import qualified View.Payment.Delete as Delete
 
 import qualified Icon
-import qualified Util.Dom           as Dom
+import qualified Util.Dom            as Dom
 
 data TableIn t = TableIn
   { _tableIn_init        :: Init
@@ -105,8 +110,17 @@ paymentRow init payment =
           M.fromList [("class", "cell button"), ("display", if _payment_user p == _init_currentUser init then "block" else "none")]
     R.elDynAttr "div" modifyAttrs $
       R.el "button" $ Icon.edit
-    R.elDynAttr "div" modifyAttrs $
-      R.el "button" $ Icon.delete
+    deletePayment <- R.elDynAttr "div" modifyAttrs $
+      _buttonOut_clic <$> (Component.button $
+        (Component.defaultButtonIn Icon.delete)
+          { _buttonIn_class = R.constDyn "deletePayment" })
+    rec
+      modalOut <- Component.modal $ ModalIn
+        { _modalIn_show    = deletePayment
+        , _modalIn_hide = _deleteOut_cancel . _modalOut_content $ modalOut
+        , _modalIn_content = Delete.view (DeleteIn {})
+        }
+    return ()
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
-- 
cgit v1.2.3


From df83b634006c699cfa1e921bf74ce951a906a62f Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Jun 2018 22:02:00 +0200
Subject: Use date input type

---
 client/src/View/Payment/Add.hs    | 8 +++++---
 client/src/View/Payment/Header.hs | 6 ++----
 2 files changed, 7 insertions(+), 7 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 2eaec0f..5ff09dd 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -8,6 +8,7 @@ import           Control.Monad.IO.Class (liftIO)
 import qualified Data.Map               as M
 import qualified Data.Maybe             as Maybe
 import qualified Data.Text              as T
+import qualified Data.Time.Calendar     as Calendar
 import qualified Data.Time.Clock        as Time
 import           Reflex.Dom             (Event, MonadWidget)
 import qualified Reflex.Dom             as R
@@ -17,7 +18,6 @@ import           Common.Model           (Category (..), CreatePayment (..),
                                          Frequency (..))
 import qualified Common.Msg             as Msg
 import qualified Common.Util.Time       as Time
-import qualified Common.View.Format     as Format
 import           Component              (ButtonIn (..), InputIn (..),
                                          InputOut (..), SelectIn (..),
                                          SelectOut (..))
@@ -49,8 +49,10 @@ view addIn = do
 
       date <- _inputOut_value <$> (Component.input $
         Component.defaultInputIn
-          { _inputIn_label = Msg.get Msg.Payment_Cost
-          , _inputIn_initialValue = Format.shortDay currentDay
+          { _inputIn_label = Msg.get Msg.Payment_Date
+          , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
+          , _inputIn_inputType = "date"
+          , _inputIn_hasResetButton = False
           })
 
       frequency <- _selectOut_value <$> (Component.select $ SelectIn
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index d01dec6..fd46c25 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -104,10 +104,8 @@ payerAndAdd incomes payments users categories currency = do
 searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text, Dynamic t Frequency)
 searchLine = do
   R.divClass "searchLine" $ do
-    searchName <- _inputOut_value <$> (Component.input $ InputIn
-      { _inputIn_reset = R.never
-      , _inputIn_label = Msg.get Msg.Search_Name
-      , _inputIn_initialValue = ""
+    searchName <- _inputOut_value <$> (Component.input $ Component.defaultInputIn
+      { _inputIn_label = Msg.get Msg.Search_Name
       })
 
     let frequencies = M.fromList
-- 
cgit v1.2.3


From 40b4994797a797b1fa86cafda789a5c488730c6d Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 28 Oct 2018 17:57:58 +0100
Subject: Delete payment

---
 client/src/View/Payment/Add.hs    |  6 +++---
 client/src/View/Payment/Delete.hs | 40 +++++++++++++++++++++++----------------
 client/src/View/Payment/Header.hs |  4 ++--
 client/src/View/Payment/Table.hs  |  2 +-
 4 files changed, 30 insertions(+), 22 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 5ff09dd..8b1b56e 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -23,7 +23,7 @@ import           Component              (ButtonIn (..), InputIn (..),
                                          SelectOut (..))
 import qualified Component              as Component
 import qualified Util.Ajax              as Ajax
-import qualified Util.WaitFor           as Util
+import qualified Util.WaitFor           as WaitFor
 
 data AddIn = AddIn
   { _addIn_categories :: [Category]
@@ -83,8 +83,8 @@ view addIn = do
               , _buttonIn_submit = True
               })
 
-          (_, waiting) <- Util.waitFor
-            (Ajax.post "/payment")
+          (_, waiting) <- WaitFor.waitFor
+            (Ajax.postJson "/payment")
             validate
             payment
 
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index a1be16d..03cf267 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -4,24 +4,27 @@ module View.Payment.Delete
   , DeleteOut(..)
   ) where
 
-import           Reflex.Dom (Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import qualified Common.Msg as Msg
-import           Component  (ButtonIn (..), ButtonOut (..))
-import qualified Component  as Component
--- import qualified Util.Ajax              as Ajax
--- import qualified Util.WaitFor           as Util
-
-data DeleteIn = DeleteIn
-  {}
+import qualified Data.Text            as T
+import           Reflex.Dom           (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom           as R
+
+import           Common.Model.Payment (PaymentId)
+import qualified Common.Msg           as Msg
+import           Component            (ButtonIn (..), ButtonOut (..))
+import qualified Component            as Component
+import qualified Util.Ajax            as Ajax
+-- import qualified Util.WaitFor           as WaitFor
+
+data DeleteIn t = DeleteIn
+  { _deleteIn_id :: Dynamic t PaymentId
+  }
 
 data DeleteOut t = DeleteOut
   { _deleteOut_cancel :: Event t ()
   }
 
-view :: forall t m. MonadWidget t m => DeleteIn -> m (DeleteOut t)
-view _ =
+view :: forall t m. MonadWidget t m => (DeleteIn t) -> m (DeleteOut t)
+view deleteIn =
   R.divClass "delete" $ do
     R.divClass "deleteHeader" $ R.text $ Msg.get Msg.Payment_DeleteConfirm
 
@@ -29,14 +32,19 @@ view _ =
 
       cancel <- R.divClass "buttons" $ do
         rec
-          _ <- Component._buttonOut_clic <$> (Component.button $
+          confirm <- Component._buttonOut_clic <$> (Component.button $
             (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
               { _buttonIn_class = R.constDyn "confirm"
               , _buttonIn_submit = True
               })
 
-          -- (_, waiting) <- Util.waitFor
-          --   (Ajax.post "/payment")
+          let url = flip fmap (_deleteIn_id deleteIn) (\id ->
+                  T.concat ["/payment/", T.pack . show $ id]
+                )
+          Ajax.delete url confirm
+
+          -- (_, waiting) <- WaitFor.waitFor
+          --   (Ajax.delete "/payment")
           --   validate
           --   payment
 
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index fd46c25..be7f6d5 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -86,7 +86,7 @@ payerAndAdd incomes payments users categories currency = do
               R.text "+ "
               R.text . Format.price currency $ _exceedingPayer_amount p
         )
-    addPayment <- _buttonOut_clic <$> (Component.button $ ButtonIn
+    addPaymentClic <- _buttonOut_clic <$> (Component.button $ ButtonIn
       { _buttonIn_class = R.constDyn "addPayment"
       , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
       , _buttonIn_waiting = R.never
@@ -95,7 +95,7 @@ payerAndAdd incomes payments users categories currency = do
       })
     rec
       modalOut <- Component.modal $ ModalIn
-        { _modalIn_show    = addPayment
+        { _modalIn_show    = addPaymentClic
         , _modalIn_hide = _addOut_cancel . _modalOut_content $ modalOut
         , _modalIn_content = Add.view $ AddIn { _addIn_categories = categories }
         }
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 23d7225..13cedda 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -118,7 +118,7 @@ paymentRow init payment =
       modalOut <- Component.modal $ ModalIn
         { _modalIn_show    = deletePayment
         , _modalIn_hide = _deleteOut_cancel . _modalOut_content $ modalOut
-        , _modalIn_content = Delete.view (DeleteIn {})
+        , _modalIn_content = Delete.view (DeleteIn { _deleteIn_id = fmap _payment_id payment })
         }
     return ()
 
-- 
cgit v1.2.3


From 50fb8fa48d1c4881da20b4ecf6d68a772301e713 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 30 Oct 2018 18:04:58 +0100
Subject: Update table when adding or removing a payment

---
 client/src/View/Payment/Add.hs    | 39 ++++++++++++-------
 client/src/View/Payment/Delete.hs | 13 +++++--
 client/src/View/Payment/Header.hs | 79 +++++++++++++++++++++++----------------
 client/src/View/Payment/Pages.hs  |  2 +-
 client/src/View/Payment/Table.hs  | 29 ++++++++------
 5 files changed, 99 insertions(+), 63 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 8b1b56e..602f7f3 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -10,12 +10,12 @@ import qualified Data.Maybe             as Maybe
 import qualified Data.Text              as T
 import qualified Data.Time.Calendar     as Calendar
 import qualified Data.Time.Clock        as Time
-import           Reflex.Dom             (Event, MonadWidget)
+import           Reflex.Dom             (Event, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
 import qualified Text.Read              as T
 
 import           Common.Model           (Category (..), CreatePayment (..),
-                                         Frequency (..))
+                                         Frequency (..), Payment (..))
 import qualified Common.Msg             as Msg
 import qualified Common.Util.Time       as Time
 import           Component              (ButtonIn (..), InputIn (..),
@@ -23,48 +23,56 @@ import           Component              (ButtonIn (..), InputIn (..),
                                          SelectOut (..))
 import qualified Component              as Component
 import qualified Util.Ajax              as Ajax
+import qualified Util.Either            as EitherUtil
 import qualified Util.WaitFor           as WaitFor
 
-data AddIn = AddIn
+data AddIn t = AddIn
   { _addIn_categories :: [Category]
+  , _addIn_show       :: Event t ()
   }
 
 data AddOut t = AddOut
-  { _addOut_cancel :: Event t ()
+  { _addOut_cancel       :: Event t ()
+  , _addOut_addedPayment :: Event t Payment
   }
 
-view :: forall t m. MonadWidget t m => AddIn -> m (AddOut t)
+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
-      name <- _inputOut_value <$> (Component.input $
-        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+      name <- _inputOut_value <$> (Component.input
+        (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+        (_addIn_show addIn))
 
-      cost <- _inputOut_value <$> (Component.input $
-        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+      cost <- _inputOut_value <$> (Component.input
+        (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+        (_addIn_show addIn))
 
       currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
 
-      date <- _inputOut_value <$> (Component.input $
-        Component.defaultInputIn
+      date <- _inputOut_value <$> (Component.input
+        (Component.defaultInputIn
           { _inputIn_label = Msg.get Msg.Payment_Date
           , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
           , _inputIn_inputType = "date"
           , _inputIn_hasResetButton = False
           })
+        (_addIn_show addIn))
 
       frequency <- _selectOut_value <$> (Component.select $ SelectIn
         { _selectIn_label = Msg.get Msg.Payment_Frequency
         , _selectIn_initialValue = Punctual
         , _selectIn_values = R.constDyn frequencies
+        , _selectIn_reset = _addIn_show addIn
         })
 
       category <- _selectOut_value <$> (Component.select $ SelectIn
         { _selectIn_label = Msg.get Msg.Payment_Category
         , _selectIn_initialValue = 0
         , _selectIn_values = R.constDyn categories
+        , _selectIn_reset = _addIn_show addIn
         })
 
       let payment = CreatePayment
@@ -74,7 +82,7 @@ view addIn = do
             <*> category
             <*> frequency
 
-      cancel <- R.divClass "buttons" $ do
+      (addedPayment, cancel) <- R.divClass "buttons" $ do
         rec
           validate <- Component._buttonOut_clic <$> (Component.button $
             (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
@@ -83,17 +91,20 @@ view addIn = do
               , _buttonIn_submit = True
               })
 
-          (_, waiting) <- WaitFor.waitFor
+          (result, waiting) <- WaitFor.waitFor
             (Ajax.postJson "/payment")
             validate
             payment
 
-        Component._buttonOut_clic <$> (Component.button $
+        cancel <- Component._buttonOut_clic <$> (Component.button $
           (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
             { _buttonIn_class = R.constDyn "undo" })
 
+        return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
+
       return AddOut
         { _addOut_cancel = cancel
+        , _addOut_addedPayment = addedPayment
         }
 
   where
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 03cf267..330ef9f 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -4,6 +4,7 @@ module View.Payment.Delete
   , DeleteOut(..)
   ) where
 
+import           Data.Text            (Text)
 import qualified Data.Text            as T
 import           Reflex.Dom           (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom           as R
@@ -13,6 +14,7 @@ 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
@@ -20,7 +22,8 @@ data DeleteIn t = DeleteIn
   }
 
 data DeleteOut t = DeleteOut
-  { _deleteOut_cancel :: Event t ()
+  { _deleteOut_cancel   :: Event t ()
+  , _deleteOut_validate :: Event t PaymentId
   }
 
 view :: forall t m. MonadWidget t m => (DeleteIn t) -> m (DeleteOut t)
@@ -30,7 +33,7 @@ view deleteIn =
 
     R.divClass "deleteContent" $ do
 
-      cancel <- R.divClass "buttons" $ do
+      (deletedPayment, cancel) <- R.divClass "buttons" $ do
         rec
           confirm <- Component._buttonOut_clic <$> (Component.button $
             (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
@@ -41,7 +44,8 @@ view deleteIn =
           let url = flip fmap (_deleteIn_id deleteIn) (\id ->
                   T.concat ["/payment/", T.pack . show $ id]
                 )
-          Ajax.delete url confirm
+
+          result <- Ajax.delete url confirm
 
           -- (_, waiting) <- WaitFor.waitFor
           --   (Ajax.delete "/payment")
@@ -52,8 +56,9 @@ view deleteIn =
           (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
             { _buttonIn_class = R.constDyn "undo" })
 
-        return cancel
+        return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
 
       return DeleteOut
         { _deleteOut_cancel = cancel
+        , _deleteOut_validate = R.tag (R.current $ _deleteIn_id deleteIn) deletedPayment
         }
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index be7f6d5..653df5e 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -13,7 +13,7 @@ import           Data.Text              (Text)
 import qualified Data.Text              as T
 import qualified Data.Time              as Time
 import           Prelude                hiding (init)
-import           Reflex.Dom             (Dynamic, MonadWidget, Reflex)
+import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
 
 import           Common.Model           (Category, Currency,
@@ -22,7 +22,6 @@ import           Common.Model           (Category, Currency,
                                          User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
-import qualified Common.Util.Text       as T
 import qualified Common.View.Format     as Format
 
 import           Component              (ButtonIn (..), ButtonOut (..),
@@ -34,44 +33,47 @@ import           View.Payment.Add       (AddIn (..), AddOut (..))
 import qualified View.Payment.Add       as Add
 
 data HeaderIn t = HeaderIn
-  { _headerIn_init :: Init
+  { _headerIn_init           :: Init
+  , _headerIn_searchPayments :: Dynamic t [Payment]
   }
 
 data HeaderOut t = HeaderOut
-  { _headerOut_searchName     :: Dynamic t Text
-  , _headerOut_searchPayments :: Dynamic t [Payment]
+  { _headerOut_searchName      :: Dynamic t Text
+  , _headerOut_searchFrequency :: Dynamic t Frequency
+  , _headerOut_addedPayment    :: Event t Payment
   }
 
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
-    payerAndAdd incomes punctualPayments users categories currency
-    (searchName, searchFrequency)  <- searchLine
-    let searchPayments = getSearchPayments searchName searchFrequency payments
-    infos searchPayments users currency
+    addedPayment <- payerAndAdd incomes punctualPayments users categories currency
+    let resetSearchName = fmap (const ()) $ addedPayment
+    (searchName, searchFrequency)  <- searchLine resetSearchName
+
+    infos (_headerIn_searchPayments headerIn) users currency
+
     return $ HeaderOut
       { _headerOut_searchName = searchName
-      , _headerOut_searchPayments = searchPayments
+      , _headerOut_searchFrequency = searchFrequency
+      , _headerOut_addedPayment = addedPayment
       }
   where
     init = _headerIn_init headerIn
     incomes = _init_incomes init
-    payments = _init_payments init
-    punctualPayments = filter ((==) Punctual . _payment_frequency) payments
+    initPayments = _init_payments init
+    punctualPayments = filter ((==) Punctual . _payment_frequency) initPayments
     users = _init_users init
     categories = _init_categories init
     currency = _init_currency init
 
-getSearchPayments :: forall t. (Reflex t) => Dynamic t Text -> Dynamic t Frequency -> [Payment] -> Dynamic t [Payment]
-getSearchPayments name frequency payments = do
-  n <- name
-  f <- frequency
-  pure $ flip filter payments (\p ->
-    (  (T.search n (_payment_name p) || T.search n (T.pack . show . _payment_cost $ p))
-    && (_payment_frequency p == f)
-    ))
-
-payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> [Category] -> Currency -> m ()
+payerAndAdd
+  :: forall t m. MonadWidget t m
+  => [Income]
+  -> [Payment]
+  -> [User]
+  -> [Category]
+  -> Currency
+  -> m (Event t Payment)
 payerAndAdd incomes payments users categories currency = do
   time <- liftIO Time.getCurrentTime
   R.divClass "payerAndAdd" $ do
@@ -94,19 +96,28 @@ payerAndAdd incomes payments users categories currency = do
       , _buttonIn_submit = False
       })
     rec
-      modalOut <- Component.modal $ ModalIn
+      modalOut <- fmap _modalOut_content . Component.modal $ ModalIn
         { _modalIn_show    = addPaymentClic
-        , _modalIn_hide = _addOut_cancel . _modalOut_content $ modalOut
-        , _modalIn_content = Add.view $ AddIn { _addIn_categories = categories }
+        , _modalIn_hide = R.leftmost $
+            [ _addOut_cancel modalOut
+            , fmap (const ()) . _addOut_addedPayment $ modalOut
+            ]
+        , _modalIn_content = Add.view $ AddIn
+            { _addIn_categories = categories
+            , _addIn_show = addPaymentClic
+            }
         }
-    return ()
+    return (_addOut_addedPayment modalOut)
 
-searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text, Dynamic t Frequency)
-searchLine = do
+searchLine
+  :: forall t m. MonadWidget t m
+  => Event t ()
+  -> m (Dynamic t Text, Dynamic t Frequency)
+searchLine reset = do
   R.divClass "searchLine" $ do
-    searchName <- _inputOut_value <$> (Component.input $ Component.defaultInputIn
-      { _inputIn_label = Msg.get Msg.Search_Name
-      })
+    searchName <- _inputOut_value <$> (Component.input
+      ( Component.defaultInputIn { _inputIn_label = Msg.get Msg.Search_Name })
+      reset)
 
     let frequencies = M.fromList
           [ (Punctual, Msg.get Msg.Payment_PunctualMale)
@@ -118,7 +129,11 @@ searchLine = do
 
     return (searchName, searchFrequency)
 
-infos :: forall t m. MonadWidget t m => Dynamic t [Payment] -> [User] -> Currency -> m ()
+infos
+  :: forall t m. MonadWidget t m
+  => Dynamic t [Payment]
+  -> [User]
+  -> Currency -> m ()
 infos payments users currency =
   R.divClass "infos" $ do
 
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index d14b640..57d67ac 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -64,7 +64,7 @@ pageButtons total perPage reset = do
     return currentPage
 
     where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
-          pageEvent = R.switchPromptlyDyn . fmap R.leftmost
+          pageEvent = R.switch . R.current . fmap R.leftmost
           noCurrentPage = R.constDyn Nothing
 
 range :: Int -> Int -> [Int]
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 13cedda..ba16bf5 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -9,11 +9,12 @@ import qualified Data.Map            as M
 import           Data.Text           (Text)
 import qualified Data.Text           as T
 import           Prelude             hiding (init)
-import           Reflex.Dom          (Dynamic, MonadWidget)
+import           Reflex.Dom          (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom          as R
 
 import           Common.Model        (Category (..), Init (..), Payment (..),
-                                      PaymentCategory (..), User (..))
+                                      PaymentCategory (..), PaymentId,
+                                      User (..))
 import qualified Common.Model        as CM
 import qualified Common.Msg          as Msg
 import qualified Common.Util.Text    as T
@@ -34,15 +35,15 @@ data TableIn t = TableIn
   , _tableIn_perPage     :: Int
   }
 
-data TableOut = TableOut
-  {
+data TableOut t = TableOut
+  { _tableOut_deletedPayment :: Event t PaymentId
   }
 
-widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut
+widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
 widget tableIn = do
   R.divClass "table" $ do
 
-    R.divClass "lines" $ do
+    deletedPayment <- 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,13 +53,14 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
         R.divClass "cell" $ R.blank
-      _ <- R.simpleList paymentRange (paymentRow init)
-      return ()
+      (R.switch . R.current . fmap R.leftmost) <$> (R.simpleList paymentRange (paymentRow init))
 
     Dom.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
       R.text $ Msg.get Msg.Payment_Empty
 
-  return $ TableOut {}
+    return $ TableOut
+      { _tableOut_deletedPayment = deletedPayment
+      }
 
   where
     init = _tableIn_init tableIn
@@ -74,7 +76,7 @@ getPaymentRange perPage payments currentPage =
     . L.sortOn _payment_date
     $ payments
 
-paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
+paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m (Event t PaymentId)
 paymentRow init payment =
   R.divClass "row" $ do
     R.divClass "cell name" . R.dynText . fmap _payment_name $ payment
@@ -117,10 +119,13 @@ paymentRow init payment =
     rec
       modalOut <- Component.modal $ ModalIn
         { _modalIn_show    = deletePayment
-        , _modalIn_hide = _deleteOut_cancel . _modalOut_content $ modalOut
+        , _modalIn_hide = R.leftmost $
+            [ _deleteOut_cancel . _modalOut_content $ modalOut
+            , fmap (const ()) . _deleteOut_validate . _modalOut_content $ modalOut
+            ]
         , _modalIn_content = Delete.view (DeleteIn { _deleteIn_id = fmap _payment_id payment })
         }
-    return ()
+    return (_deleteOut_validate . _modalOut_content $ modalOut)
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
-- 
cgit v1.2.3


From 8a28f608d8e08fba4bbe54b46804d261686c3c03 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 30 Oct 2018 20:33:17 +0100
Subject: Upgrade reflex-platform

---
 client/src/View/Payment/Header.hs | 1 +
 1 file changed, 1 insertion(+)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 653df5e..6fbaecf 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -11,6 +11,7 @@ import qualified Data.Map               as M
 import           Data.Maybe             (fromMaybe)
 import           Data.Text              (Text)
 import qualified Data.Text              as T
+import           Data.Time              (NominalDiffTime)
 import qualified Data.Time              as Time
 import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex)
-- 
cgit v1.2.3


From b5244184920b4d7a8d64eada2eca21e9a6ea2df9 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 30 Oct 2018 20:44:12 +0100
Subject: Use waitfor with delete confirm button

---
 client/src/View/Payment/Add.hs    |  3 +--
 client/src/View/Payment/Delete.hs | 12 +++++-------
 2 files changed, 6 insertions(+), 9 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 602f7f3..1864e76 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -93,8 +93,7 @@ view addIn = do
 
           (result, waiting) <- WaitFor.waitFor
             (Ajax.postJson "/payment")
-            validate
-            payment
+            (R.tag (R.current payment) validate)
 
         cancel <- Component._buttonOut_clic <$> (Component.button $
           (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 330ef9f..81c7c57 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -15,7 +15,7 @@ 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
+import qualified Util.WaitFor         as WaitFor
 
 data DeleteIn t = DeleteIn
   { _deleteIn_id :: Dynamic t PaymentId
@@ -39,18 +39,16 @@ view deleteIn =
             (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
               { _buttonIn_class = R.constDyn "confirm"
               , _buttonIn_submit = True
+              , _buttonIn_waiting = waiting
               })
 
           let url = flip fmap (_deleteIn_id deleteIn) (\id ->
                   T.concat ["/payment/", T.pack . show $ id]
                 )
 
-          result <- Ajax.delete url confirm
-
-          -- (_, waiting) <- WaitFor.waitFor
-          --   (Ajax.delete "/payment")
-          --   validate
-          --   payment
+          (result, waiting) <- WaitFor.waitFor
+            (Ajax.delete url)
+            confirm
 
         cancel <- Component._buttonOut_clic <$> (Component.button $
           (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
-- 
cgit v1.2.3


From 86957359ecf54c205aee1c09e151172c327e987a Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 31 Oct 2018 19:03:19 +0100
Subject: Various fixes

---
 client/src/View/Payment/Add.hs | 115 +++++++++++++++++++++--------------------
 1 file changed, 58 insertions(+), 57 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 1864e76..061eeeb 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -42,64 +42,65 @@ view addIn = do
     R.divClass "addHeader" $ R.text $ Msg.get Msg.Payment_Add
 
     R.divClass "addContent" $ do
-      name <- _inputOut_value <$> (Component.input
-        (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
-        (_addIn_show addIn))
-
-      cost <- _inputOut_value <$> (Component.input
-        (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
-        (_addIn_show addIn))
-
-      currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
-
-      date <- _inputOut_value <$> (Component.input
-        (Component.defaultInputIn
-          { _inputIn_label = Msg.get Msg.Payment_Date
-          , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
-          , _inputIn_inputType = "date"
-          , _inputIn_hasResetButton = False
+      rec
+        name <- _inputOut_value <$> (Component.input
+          (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+          (const () <$ addedPayment))
+
+        cost <- _inputOut_value <$> (Component.input
+          (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+          (const () <$ addedPayment))
+
+        currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+
+        date <- _inputOut_value <$> (Component.input
+          (Component.defaultInputIn
+            { _inputIn_label = Msg.get Msg.Payment_Date
+            , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
+            , _inputIn_inputType = "date"
+            , _inputIn_hasResetButton = False
+            })
+          (const () <$ addedPayment))
+
+        frequency <- _selectOut_value <$> (Component.select $ SelectIn
+          { _selectIn_label = Msg.get Msg.Payment_Frequency
+          , _selectIn_initialValue = Punctual
+          , _selectIn_values = R.constDyn frequencies
+          , _selectIn_reset = _addIn_show addIn
           })
-        (_addIn_show addIn))
-
-      frequency <- _selectOut_value <$> (Component.select $ SelectIn
-        { _selectIn_label = Msg.get Msg.Payment_Frequency
-        , _selectIn_initialValue = Punctual
-        , _selectIn_values = R.constDyn frequencies
-        , _selectIn_reset = _addIn_show addIn
-        })
-
-      category <- _selectOut_value <$> (Component.select $ SelectIn
-        { _selectIn_label = Msg.get Msg.Payment_Category
-        , _selectIn_initialValue = 0
-        , _selectIn_values = R.constDyn categories
-        , _selectIn_reset = _addIn_show addIn
-        })
-
-      let payment = CreatePayment
-            <$> name
-            <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
-            <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
-            <*> category
-            <*> frequency
-
-      (addedPayment, cancel) <- R.divClass "buttons" $ do
-        rec
-          validate <- 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
-              })
-
-          (result, waiting) <- WaitFor.waitFor
-            (Ajax.postJson "/payment")
-            (R.tag (R.current payment) validate)
-
-        cancel <- Component._buttonOut_clic <$> (Component.button $
-          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
-            { _buttonIn_class = R.constDyn "undo" })
-
-        return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
+
+        category <- _selectOut_value <$> (Component.select $ SelectIn
+          { _selectIn_label = Msg.get Msg.Payment_Category
+          , _selectIn_initialValue = 0
+          , _selectIn_values = R.constDyn categories
+          , _selectIn_reset = _addIn_show addIn
+          })
+
+        let payment = CreatePayment
+              <$> name
+              <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
+              <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
+              <*> category
+              <*> frequency
+
+        (addedPayment, cancel) <- R.divClass "buttons" $ do
+          rec
+            validate <- 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
+                })
+
+            (result, waiting) <- WaitFor.waitFor
+              (Ajax.postJson "/payment")
+              (R.tag (R.current payment) validate)
+
+          cancel <- Component._buttonOut_clic <$> (Component.button $
+            (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+              { _buttonIn_class = R.constDyn "undo" })
+
+          return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
 
       return AddOut
         { _addOut_cancel = cancel
-- 
cgit v1.2.3


From 2741f47ef7b87255203bc2f7f7b2b9140c70b8f0 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 1 Nov 2018 13:14:25 +0100
Subject: Implementing client side validation

---
 client/src/View/Payment/Add.hs    | 127 ++++++++++++++++++++++++--------------
 client/src/View/Payment/Header.hs |  16 ++---
 client/src/View/Payment/Pages.hs  |   2 +-
 3 files changed, 91 insertions(+), 54 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 061eeeb..62b26a3 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -4,31 +4,34 @@ module View.Payment.Add
   , AddOut(..)
   ) where
 
-import           Control.Monad.IO.Class (liftIO)
-import qualified Data.Map               as M
-import qualified Data.Maybe             as Maybe
-import qualified Data.Text              as T
-import qualified Data.Time.Calendar     as Calendar
-import qualified Data.Time.Clock        as Time
-import           Reflex.Dom             (Event, MonadWidget, Reflex)
-import qualified Reflex.Dom             as R
-import qualified Text.Read              as T
-
-import           Common.Model           (Category (..), CreatePayment (..),
-                                         Frequency (..), Payment (..))
-import qualified Common.Msg             as Msg
-import qualified Common.Util.Time       as Time
-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.WaitFor           as WaitFor
+import           Control.Monad.IO.Class    (liftIO)
+import qualified Data.Map                  as M
+import qualified Data.Maybe                as Maybe
+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                (Event, MonadWidget, Reflex)
+import qualified Reflex.Dom                as R
+import qualified Text.Read                 as T
+
+import           Common.Model              (Category (..), CreatePayment (..),
+                                            Frequency (..), Payment (..))
+import qualified Common.Msg                as Msg
+import qualified Common.Util.Time          as Time
+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_show       :: Event t ()
+  , _addIn_cancel     :: Event t ()
   }
 
 data AddOut t = AddOut
@@ -43,48 +46,84 @@ view addIn = do
 
     R.divClass "addContent" $ do
       rec
+        let reset = R.leftmost
+              [ const "" <$> cancel
+              , const "" <$> addedPayment
+              , const "" <$> _addIn_cancel addIn
+              ]
+
         name <- _inputOut_value <$> (Component.input
-          (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
-          (const () <$ addedPayment))
+          (Component.defaultInputIn
+            { _inputIn_label = Msg.get Msg.Payment_Name
+            , _inputIn_validation = PaymentValidation.name
+            })
+          reset
+          validate)
 
         cost <- _inputOut_value <$> (Component.input
-          (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
-          (const () <$ addedPayment))
+          (Component.defaultInputIn
+            { _inputIn_label = Msg.get Msg.Payment_Cost
+            , _inputIn_validation = PaymentValidation.cost
+            })
+          reset
+          validate)
 
-        currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+        currentDay <- do
+          d <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+          return . T.pack . Calendar.showGregorian $ d
 
         date <- _inputOut_value <$> (Component.input
           (Component.defaultInputIn
             { _inputIn_label = Msg.get Msg.Payment_Date
-            , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
+            , _inputIn_initialValue = currentDay
             , _inputIn_inputType = "date"
             , _inputIn_hasResetButton = False
+            , _inputIn_validation = PaymentValidation.date
             })
-          (const () <$ addedPayment))
+          (const currentDay <$> reset)
+          validate)
 
         frequency <- _selectOut_value <$> (Component.select $ SelectIn
           { _selectIn_label = Msg.get Msg.Payment_Frequency
           , _selectIn_initialValue = Punctual
           , _selectIn_values = R.constDyn frequencies
-          , _selectIn_reset = _addIn_show addIn
+          , _selectIn_reset = reset
+          , _selectIn_isValid = const True
+          , _selectIn_validate = validate
           })
 
         category <- _selectOut_value <$> (Component.select $ SelectIn
           { _selectIn_label = Msg.get Msg.Payment_Category
-          , _selectIn_initialValue = 0
+          , _selectIn_initialValue = -1
           , _selectIn_values = R.constDyn categories
-          , _selectIn_reset = _addIn_show addIn
+          , _selectIn_reset = reset
+          , _selectIn_isValid = \id -> id /= -1
+          , _selectIn_validate = validate
           })
 
-        let payment = CreatePayment
-              <$> name
-              <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
-              <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
-              <*> category
-              <*> frequency
-
-        (addedPayment, cancel) <- R.divClass "buttons" $ do
+        let payment = do
+              n <- name
+              c <- cost
+              d <- date
+              cat <- category
+              f <- frequency
+              pure $ do
+                n' <- n
+                c' <- c
+                d' <- d
+                pure $ CreatePayment
+                  <$> ValidationUtil.nelError n'
+                  <*> ValidationUtil.nelError c'
+                  <*> ValidationUtil.nelError d'
+                  <*> ValidationUtil.nelError (V.Success cat)
+                  <*> ValidationUtil.nelError (V.Success f)
+
+        (addedPayment, cancel, validate) <- 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" })
+
             validate <- Component._buttonOut_clic <$> (Component.button $
               (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
                 { _buttonIn_class = R.constDyn "confirm"
@@ -94,13 +133,9 @@ view addIn = do
 
             (result, waiting) <- WaitFor.waitFor
               (Ajax.postJson "/payment")
-              (R.tag (R.current payment) validate)
-
-          cancel <- Component._buttonOut_clic <$> (Component.button $
-            (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
-              { _buttonIn_class = R.constDyn "undo" })
+              (ValidationUtil.fireValidation payment validate)
 
-          return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
+          return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel, validate)
 
       return AddOut
         { _addOut_cancel = cancel
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 6fbaecf..56441eb 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -97,18 +97,19 @@ payerAndAdd incomes payments users categories currency = do
       , _buttonIn_submit = False
       })
     rec
-      modalOut <- fmap _modalOut_content . Component.modal $ ModalIn
+      modalOut <- Component.modal $ ModalIn
         { _modalIn_show    = addPaymentClic
         , _modalIn_hide = R.leftmost $
-            [ _addOut_cancel modalOut
-            , fmap (const ()) . _addOut_addedPayment $ modalOut
+            [ _addOut_cancel addOut
+            , fmap (const ()) . _addOut_addedPayment $ addOut
             ]
         , _modalIn_content = Add.view $ AddIn
             { _addIn_categories = categories
-            , _addIn_show = addPaymentClic
+            , _addIn_cancel = _modalOut_hide modalOut
             }
         }
-    return (_addOut_addedPayment modalOut)
+      let addOut = _modalOut_content modalOut
+    return (_addOut_addedPayment addOut)
 
 searchLine
   :: forall t m. MonadWidget t m
@@ -116,9 +117,10 @@ searchLine
   -> m (Dynamic t Text, Dynamic t Frequency)
 searchLine reset = do
   R.divClass "searchLine" $ do
-    searchName <- _inputOut_value <$> (Component.input
+    searchName <- _inputOut_raw <$> (Component.input
       ( Component.defaultInputIn { _inputIn_label = Msg.get Msg.Search_Name })
-      reset)
+      (const "" <$> reset)
+      R.never)
 
     let frequencies = M.fromList
           [ (Punctual, Msg.get Msg.Payment_PunctualMale)
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 57d67ac..cbe7b50 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -47,7 +47,7 @@ pageButtons total perPage reset = do
         , pageClic
         , nextPageClic
         , lastPageClic
-        , (const 1) <$> reset
+        , 1 <$ reset
         ]
 
       firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
-- 
cgit v1.2.3


From bc81084933f8ec1bfe6c2834defd12243117fdd9 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 5 Aug 2019 21:53:30 +0200
Subject: Use updated payment categories from payment add in payment’s table

---
 client/src/View/Payment/Add.hs    | 22 +++++++++++++---------
 client/src/View/Payment/Header.hs | 22 +++++++++++-----------
 client/src/View/Payment/Table.hs  | 31 +++++++++++++++++--------------
 3 files changed, 41 insertions(+), 34 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 62b26a3..2970394 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -16,7 +16,8 @@ import qualified Reflex.Dom                as R
 import qualified Text.Read                 as T
 
 import           Common.Model              (Category (..), CreatePayment (..),
-                                            Frequency (..), Payment (..))
+                                            CreatedPayment (..), Frequency (..),
+                                            Payment (..), PaymentCategory (..))
 import qualified Common.Msg                as Msg
 import qualified Common.Util.Time          as Time
 import qualified Common.Validation.Payment as PaymentValidation
@@ -35,8 +36,9 @@ data AddIn t = AddIn
   }
 
 data AddOut t = AddOut
-  { _addOut_cancel       :: Event t ()
-  , _addOut_addedPayment :: Event t Payment
+  { _addOut_cancel             :: Event t ()
+  , _addOut_addPayment         :: Event t CreatedPayment
+  , _addOut_addPaymentCategory :: Event t PaymentCategory
   }
 
 view :: forall t m. MonadWidget t m => AddIn t -> m (AddOut t)
@@ -48,7 +50,7 @@ view addIn = do
       rec
         let reset = R.leftmost
               [ const "" <$> cancel
-              , const "" <$> addedPayment
+              , const "" <$> addPayment
               , const "" <$> _addIn_cancel addIn
               ]
 
@@ -68,8 +70,10 @@ view addIn = do
           reset
           validate)
 
+        now <- liftIO Time.getCurrentTime
+
         currentDay <- do
-          d <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+          d <- liftIO $ Time.timeToDay now
           return . T.pack . Calendar.showGregorian $ d
 
         date <- _inputOut_value <$> (Component.input
@@ -118,7 +122,7 @@ view addIn = do
                   <*> ValidationUtil.nelError (V.Success cat)
                   <*> ValidationUtil.nelError (V.Success f)
 
-        (addedPayment, cancel, validate) <- R.divClass "buttons" $ do
+        (addPayment, cancel, validate) <- R.divClass "buttons" $ do
           rec
             cancel <- Component._buttonOut_clic <$> (Component.button $
               (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
@@ -131,15 +135,15 @@ view addIn = do
                 , _buttonIn_submit = True
                 })
 
-            (result, waiting) <- WaitFor.waitFor
+            (addPayment, waiting) <- WaitFor.waitFor
               (Ajax.postJson "/payment")
               (ValidationUtil.fireValidation payment validate)
 
-          return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel, validate)
+          return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, validate)
 
       return AddOut
         { _addOut_cancel = cancel
-        , _addOut_addedPayment = addedPayment
+        , _addOut_addPayment = addPayment
         }
 
   where
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 56441eb..c49b284 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, Currency,
-                                         ExceedingPayer (..), Frequency (..),
-                                         Income (..), Init (..), Payment (..),
-                                         User (..))
+import           Common.Model           (Category, CreatedPayment (..),
+                                         Currency, ExceedingPayer (..),
+                                         Frequency (..), Income (..), Init (..),
+                                         Payment (..), User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.View.Format     as Format
@@ -41,14 +41,14 @@ data HeaderIn t = HeaderIn
 data HeaderOut t = HeaderOut
   { _headerOut_searchName      :: Dynamic t Text
   , _headerOut_searchFrequency :: Dynamic t Frequency
-  , _headerOut_addedPayment    :: Event t Payment
+  , _headerOut_addPayment      :: Event t CreatedPayment
   }
 
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
-    addedPayment <- payerAndAdd incomes punctualPayments users categories currency
-    let resetSearchName = fmap (const ()) $ addedPayment
+    addPayment <- payerAndAdd incomes punctualPayments users categories currency
+    let resetSearchName = fmap (const ()) $ addPayment
     (searchName, searchFrequency)  <- searchLine resetSearchName
 
     infos (_headerIn_searchPayments headerIn) users currency
@@ -56,7 +56,7 @@ widget headerIn =
     return $ HeaderOut
       { _headerOut_searchName = searchName
       , _headerOut_searchFrequency = searchFrequency
-      , _headerOut_addedPayment = addedPayment
+      , _headerOut_addPayment = addPayment
       }
   where
     init = _headerIn_init headerIn
@@ -74,7 +74,7 @@ payerAndAdd
   -> [User]
   -> [Category]
   -> Currency
-  -> m (Event t Payment)
+  -> m (Event t CreatedPayment)
 payerAndAdd incomes payments users categories currency = do
   time <- liftIO Time.getCurrentTime
   R.divClass "payerAndAdd" $ do
@@ -101,7 +101,7 @@ payerAndAdd incomes payments users categories currency = do
         { _modalIn_show    = addPaymentClic
         , _modalIn_hide = R.leftmost $
             [ _addOut_cancel addOut
-            , fmap (const ()) . _addOut_addedPayment $ addOut
+            , fmap (const ()) . _addOut_addPayment $ addOut
             ]
         , _modalIn_content = Add.view $ AddIn
             { _addIn_categories = categories
@@ -109,7 +109,7 @@ payerAndAdd incomes payments users categories currency = do
             }
         }
       let addOut = _modalOut_content modalOut
-    return (_addOut_addedPayment addOut)
+    return (_addOut_addPayment addOut)
 
 searchLine
   :: forall t m. MonadWidget t m
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index ba16bf5..6432274 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -29,21 +29,22 @@ import qualified Icon
 import qualified Util.Dom            as Dom
 
 data TableIn t = TableIn
-  { _tableIn_init        :: Init
-  , _tableIn_currentPage :: Dynamic t Int
-  , _tableIn_payments    :: Dynamic t [Payment]
-  , _tableIn_perPage     :: Int
+  { _tableIn_init              :: Init
+  , _tableIn_currentPage       :: Dynamic t Int
+  , _tableIn_payments          :: Dynamic t [Payment]
+  , _tableIn_perPage           :: Int
+  , _tableIn_paymentCategories :: Dynamic t [PaymentCategory]
   }
 
 data TableOut t = TableOut
-  { _tableOut_deletedPayment :: Event t PaymentId
+  { _tableOut_deletePayment :: Event t PaymentId
   }
 
 widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
 widget tableIn = do
   R.divClass "table" $ do
 
-    deletedPayment <- R.divClass "lines" $ do
+    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
@@ -53,13 +54,14 @@ 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) <$> (R.simpleList paymentRange (paymentRow init))
+      (R.switch . R.current . fmap R.leftmost) <$>
+        (R.simpleList paymentRange (paymentRow init paymentCategories))
 
     Dom.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
       R.text $ Msg.get Msg.Payment_Empty
 
     return $ TableOut
-      { _tableOut_deletedPayment = deletedPayment
+      { _tableOut_deletePayment = deletePayment
       }
 
   where
@@ -67,6 +69,7 @@ widget tableIn = do
     currentPage = _tableIn_currentPage tableIn
     payments = _tableIn_payments tableIn
     paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage
+    paymentCategories = _tableIn_paymentCategories tableIn
 
 getPaymentRange :: Int -> [Payment] -> Int -> [Payment]
 getPaymentRange perPage payments currentPage =
@@ -76,8 +79,8 @@ getPaymentRange perPage payments currentPage =
     . L.sortOn _payment_date
     $ payments
 
-paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m (Event t PaymentId)
-paymentRow init payment =
+paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t [PaymentCategory] -> Dynamic t Payment -> m (Event t PaymentId)
+paymentRow init 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 (_init_currency init) . _payment_cost) $  payment
@@ -88,10 +91,10 @@ paymentRow init payment =
         Just u -> _user_name u
         _      -> ""
 
-    let category = flip fmap payment $ \p -> findCategory
-          (_init_categories init)
-          (_init_paymentCategories init)
-          (_payment_name p)
+    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
-- 
cgit v1.2.3


From fc8be14dd0089eb12b78af7aaaecd8ed57896677 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 7 Aug 2019 21:27:59 +0200
Subject: Update category according to payment in add overlay

---
 client/src/View/Payment/Add.hs    | 33 ++++++++++++++++++-----
 client/src/View/Payment/Delete.hs |  9 ++++---
 client/src/View/Payment/Header.hs | 15 +++++++----
 client/src/View/Payment/Table.hs  | 57 ++++++++++++++++++++++++++++-----------
 4 files changed, 82 insertions(+), 32 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 2970394..d023613 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -4,21 +4,26 @@ module View.Payment.Add
   , AddOut(..)
   ) 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                (Event, MonadWidget, Reflex)
+import           Reflex.Dom                (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom                as R
 import qualified Text.Read                 as T
 
-import           Common.Model              (Category (..), CreatePayment (..),
+import           Common.Model              (Category (..), CategoryId,
+                                            CreatePayment (..),
                                             CreatedPayment (..), Frequency (..),
                                             Payment (..), PaymentCategory (..))
 import qualified Common.Msg                as Msg
+import qualified Common.Util.Text          as Text
 import qualified Common.Util.Time          as Time
 import qualified Common.Validation.Payment as PaymentValidation
 import           Component                 (ButtonIn (..), InputIn (..),
@@ -31,8 +36,9 @@ import qualified Util.Validation           as ValidationUtil
 import qualified Util.WaitFor              as WaitFor
 
 data AddIn t = AddIn
-  { _addIn_categories :: [Category]
-  , _addIn_cancel     :: Event t ()
+  { _addIn_categories        :: [Category]
+  , _addIn_paymentCategories :: Dynamic t [PaymentCategory]
+  , _addIn_cancel            :: Event t ()
   }
 
 data AddOut t = AddOut
@@ -54,13 +60,13 @@ view addIn = do
               , const "" <$> _addIn_cancel addIn
               ]
 
-        name <- _inputOut_value <$> (Component.input
+        name <- Component.input
           (Component.defaultInputIn
             { _inputIn_label = Msg.get Msg.Payment_Name
             , _inputIn_validation = PaymentValidation.name
             })
           reset
-          validate)
+          validate
 
         cost <- _inputOut_value <$> (Component.input
           (Component.defaultInputIn
@@ -90,15 +96,22 @@ view addIn = do
         frequency <- _selectOut_value <$> (Component.select $ SelectIn
           { _selectIn_label = Msg.get Msg.Payment_Frequency
           , _selectIn_initialValue = Punctual
+          , _selectIn_value = R.never
           , _selectIn_values = R.constDyn frequencies
           , _selectIn_reset = reset
           , _selectIn_isValid = const True
           , _selectIn_validate = validate
           })
 
+        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
@@ -106,7 +119,7 @@ view addIn = do
           })
 
         let payment = do
-              n <- name
+              n <- _inputOut_value name
               c <- cost
               d <- date
               cat <- category
@@ -154,3 +167,9 @@ view addIn = do
 
     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 ((==) (Text.formatSearch paymentName) . _paymentCategory_name)
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 81c7c57..4aa10f3 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -34,6 +34,11 @@ view deleteIn =
     R.divClass "deleteContent" $ do
 
       (deletedPayment, cancel) <- R.divClass "buttons" $ do
+
+        cancel <- Component._buttonOut_clic <$> (Component.button $
+          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+            { _buttonIn_class = R.constDyn "undo" })
+
         rec
           confirm <- Component._buttonOut_clic <$> (Component.button $
             (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
@@ -50,10 +55,6 @@ view deleteIn =
             (Ajax.delete url)
             confirm
 
-        cancel <- Component._buttonOut_clic <$> (Component.button $
-          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
-            { _buttonIn_class = R.constDyn "undo" })
-
         return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
 
       return DeleteOut
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index c49b284..5cc362a 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -20,7 +20,8 @@ import qualified Reflex.Dom             as R
 import           Common.Model           (Category, CreatedPayment (..),
                                          Currency, ExceedingPayer (..),
                                          Frequency (..), Income (..), Init (..),
-                                         Payment (..), User (..))
+                                         Payment (..), PaymentCategory,
+                                         User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.View.Format     as Format
@@ -34,8 +35,9 @@ import           View.Payment.Add       (AddIn (..), AddOut (..))
 import qualified View.Payment.Add       as Add
 
 data HeaderIn t = HeaderIn
-  { _headerIn_init           :: Init
-  , _headerIn_searchPayments :: Dynamic t [Payment]
+  { _headerIn_init              :: Init
+  , _headerIn_searchPayments    :: Dynamic t [Payment]
+  , _headerIn_paymentCategories :: Dynamic t [PaymentCategory]
   }
 
 data HeaderOut t = HeaderOut
@@ -47,7 +49,7 @@ data HeaderOut t = HeaderOut
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
-    addPayment <- payerAndAdd incomes punctualPayments users categories currency
+    addPayment <- payerAndAdd incomes punctualPayments users categories paymentCategories currency
     let resetSearchName = fmap (const ()) $ addPayment
     (searchName, searchFrequency)  <- searchLine resetSearchName
 
@@ -66,6 +68,7 @@ widget headerIn =
     users = _init_users init
     categories = _init_categories init
     currency = _init_currency init
+    paymentCategories = _headerIn_paymentCategories headerIn
 
 payerAndAdd
   :: forall t m. MonadWidget t m
@@ -73,9 +76,10 @@ payerAndAdd
   -> [Payment]
   -> [User]
   -> [Category]
+  -> Dynamic t [PaymentCategory]
   -> Currency
   -> m (Event t CreatedPayment)
-payerAndAdd incomes payments users categories currency = do
+payerAndAdd incomes payments users categories paymentCategories currency = do
   time <- liftIO Time.getCurrentTime
   R.divClass "payerAndAdd" $ do
     R.divClass "exceedingPayers" $
@@ -105,6 +109,7 @@ payerAndAdd incomes payments users categories currency = do
             ]
         , _modalIn_content = Add.view $ AddIn
             { _addIn_categories = categories
+            , _addIn_paymentCategories = paymentCategories
             , _addIn_cancel = _modalOut_hide modalOut
             }
         }
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 6432274..cdc4bb3 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -26,7 +26,7 @@ import           View.Payment.Delete (DeleteIn (..), DeleteOut (..))
 import qualified View.Payment.Delete as Delete
 
 import qualified Icon
-import qualified Util.Dom            as Dom
+import qualified Util.Dom            as DomUtil
 
 data TableIn t = TableIn
   { _tableIn_init              :: Init
@@ -57,7 +57,7 @@ widget tableIn = do
       (R.switch . R.current . fmap R.leftmost) <$>
         (R.simpleList paymentRange (paymentRow init paymentCategories))
 
-    Dom.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
+    DomUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
       R.text $ Msg.get Msg.Payment_Empty
 
     return $ TableOut
@@ -79,13 +79,24 @@ getPaymentRange perPage payments currentPage =
     . L.sortOn _payment_date
     $ payments
 
-paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t [PaymentCategory] -> Dynamic t Payment -> m (Event t PaymentId)
+paymentRow
+  :: forall t m. MonadWidget t m
+  => Init
+  -> Dynamic t [PaymentCategory]
+  -> Dynamic t Payment
+  -> m (Event t PaymentId)
 paymentRow init 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 (_init_currency init) . _payment_cost) $  payment
 
-    let user = flip fmap payment $ \p -> CM.findUser (_payment_user p) (_init_users init)
+    R.divClass "cell name" $
+      R.dynText $ fmap _payment_name payment
+
+    R.divClass "cell cost" $
+      R.dynText $ fmap (Format.price (_init_currency init) . _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
@@ -95,13 +106,16 @@ paymentRow init paymentCategories payment =
           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 $ flip fmap category $ \mbCategory -> case mbCategory of
           Just c -> _category_name c
@@ -110,15 +124,26 @@ paymentRow init paymentCategories payment =
     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
-    R.divClass "cell button" . R.el "button" $ Icon.clone
-    let modifyAttrs = flip fmap payment $ \p ->
-          M.fromList [("class", "cell button"), ("display", if _payment_user p == _init_currentUser init then "block" else "none")]
-    R.elDynAttr "div" modifyAttrs $
-      R.el "button" $ Icon.edit
-    deletePayment <- R.elDynAttr "div" modifyAttrs $
-      _buttonOut_clic <$> (Component.button $
-        (Component.defaultButtonIn Icon.delete)
-          { _buttonIn_class = R.constDyn "deletePayment" })
+
+    R.divClass "cell button" $
+      R.el "button" Icon.clone
+
+    let isFromCurrentUser =
+          R.ffor
+            payment
+            (\p -> _payment_user p == _init_currentUser init)
+
+    R.divClass "cell button" $
+      DomUtil.divVisibleIf isFromCurrentUser $
+        R.el "button" Icon.edit
+
+    deletePayment <-
+      R.divClass "cell button" $
+        DomUtil.divVisibleIf isFromCurrentUser $
+          _buttonOut_clic <$> (Component.button $
+            (Component.defaultButtonIn Icon.delete)
+              { _buttonIn_class = R.constDyn "deletePayment" })
+
     rec
       modalOut <- Component.modal $ ModalIn
         { _modalIn_show    = deletePayment
@@ -133,6 +158,6 @@ paymentRow init paymentCategories payment =
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
   paymentCategory <- L.find
-    ((== (T.unaccent . T.toLower) paymentName) . _paymentCategory_name)
+    ((== T.formatSearch paymentName) . _paymentCategory_name)
     paymentCategories
   L.find ((== (_paymentCategory_category paymentCategory)) . _category_id) categories
-- 
cgit v1.2.3


From 7c77e52faa71e43324087903c905f9d493b1dfb7 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 8 Aug 2019 21:28:22 +0200
Subject: Finish payment add modal

---
 client/src/View/Payment/Add.hs    | 36 ++++++++++++++++--------------------
 client/src/View/Payment/Header.hs | 34 +++++++++++++++++++++-------------
 2 files changed, 37 insertions(+), 33 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index d023613..e0772f7 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -66,7 +66,7 @@ view addIn = do
             , _inputIn_validation = PaymentValidation.name
             })
           reset
-          validate
+          confirm
 
         cost <- _inputOut_value <$> (Component.input
           (Component.defaultInputIn
@@ -74,7 +74,7 @@ view addIn = do
             , _inputIn_validation = PaymentValidation.cost
             })
           reset
-          validate)
+          confirm)
 
         now <- liftIO Time.getCurrentTime
 
@@ -91,7 +91,7 @@ view addIn = do
             , _inputIn_validation = PaymentValidation.date
             })
           (const currentDay <$> reset)
-          validate)
+          confirm)
 
         frequency <- _selectOut_value <$> (Component.select $ SelectIn
           { _selectIn_label = Msg.get Msg.Payment_Frequency
@@ -100,7 +100,7 @@ view addIn = do
           , _selectIn_values = R.constDyn frequencies
           , _selectIn_reset = reset
           , _selectIn_isValid = const True
-          , _selectIn_validate = validate
+          , _selectIn_validate = confirm
           })
 
         let setCategory =
@@ -115,7 +115,7 @@ view addIn = do
           , _selectIn_values = R.constDyn categories
           , _selectIn_reset = reset
           , _selectIn_isValid = \id -> id /= -1
-          , _selectIn_validate = validate
+          , _selectIn_validate = confirm
           })
 
         let payment = do
@@ -124,24 +124,20 @@ view addIn = do
               d <- date
               cat <- category
               f <- frequency
-              pure $ do
-                n' <- n
-                c' <- c
-                d' <- d
-                pure $ CreatePayment
-                  <$> ValidationUtil.nelError n'
-                  <*> ValidationUtil.nelError c'
-                  <*> ValidationUtil.nelError d'
-                  <*> ValidationUtil.nelError (V.Success cat)
-                  <*> ValidationUtil.nelError (V.Success f)
-
-        (addPayment, cancel, validate) <- R.divClass "buttons" $ do
+              return (CreatePayment
+                <$> ValidationUtil.nelError n
+                <*> ValidationUtil.nelError c
+                <*> ValidationUtil.nelError d
+                <*> ValidationUtil.nelError cat
+                <*> ValidationUtil.nelError 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" })
 
-            validate <- Component._buttonOut_clic <$> (Component.button $
+            confirm <- Component._buttonOut_clic <$> (Component.button $
               (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
                 { _buttonIn_class = R.constDyn "confirm"
                 , _buttonIn_waiting = waiting
@@ -150,9 +146,9 @@ view addIn = do
 
             (addPayment, waiting) <- WaitFor.waitFor
               (Ajax.postJson "/payment")
-              (ValidationUtil.fireValidation payment validate)
+              (ValidationUtil.fireValidation payment confirm)
 
-          return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, validate)
+          return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, confirm)
 
       return AddOut
         { _addOut_cancel = cancel
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 5cc362a..73517f0 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -36,6 +36,7 @@ import qualified View.Payment.Add       as Add
 
 data HeaderIn t = HeaderIn
   { _headerIn_init              :: Init
+  , _headerIn_payments          :: Dynamic t [Payment]
   , _headerIn_searchPayments    :: Dynamic t [Payment]
   , _headerIn_paymentCategories :: Dynamic t [PaymentCategory]
   }
@@ -49,7 +50,7 @@ data HeaderOut t = HeaderOut
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
-    addPayment <- payerAndAdd incomes punctualPayments users categories paymentCategories currency
+    addPayment <- payerAndAdd incomes payments users categories paymentCategories currency
     let resetSearchName = fmap (const ()) $ addPayment
     (searchName, searchFrequency)  <- searchLine resetSearchName
 
@@ -64,7 +65,7 @@ widget headerIn =
     init = _headerIn_init headerIn
     incomes = _init_incomes init
     initPayments = _init_payments init
-    punctualPayments = filter ((==) Punctual . _payment_frequency) initPayments
+    payments = _headerIn_payments headerIn
     users = _init_users init
     categories = _init_categories init
     currency = _init_currency init
@@ -73,7 +74,7 @@ widget headerIn =
 payerAndAdd
   :: forall t m. MonadWidget t m
   => [Income]
-  -> [Payment]
+  -> Dynamic t [Payment]
   -> [User]
   -> [Category]
   -> Dynamic t [PaymentCategory]
@@ -82,17 +83,23 @@ payerAndAdd
 payerAndAdd incomes payments users categories paymentCategories currency = do
   time <- liftIO Time.getCurrentTime
   R.divClass "payerAndAdd" $ do
+
+    let exceedingPayers =
+          R.ffor payments $ \ps ->
+            CM.getExceedingPayers time users incomes $
+              filter ((==) Punctual . _payment_frequency) ps
+
     R.divClass "exceedingPayers" $
-      forM_
-        (CM.getExceedingPayers time users incomes payments)
-        (\p ->
-          R.elClass "span" "exceedingPayer" $ do
-            R.elClass "span" "userName" $
-              R.text . fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId p) users
-            R.elClass "span" "amount" $ do
-              R.text "+ "
-              R.text . Format.price currency $ _exceedingPayer_amount p
-        )
+      R.simpleList exceedingPayers $ \exceedingPayer ->
+        R.elClass "span" "exceedingPayer" $ do
+          R.elClass "span" "userName" $
+            R.dynText . R.ffor exceedingPayer $ \ep ->
+              fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId ep) users
+          R.elClass "span" "amount" $ do
+            R.text "+ "
+            R.dynText . R.ffor exceedingPayer $ \ep ->
+              Format.price currency $ _exceedingPayer_amount ep
+
     addPaymentClic <- _buttonOut_clic <$> (Component.button $ ButtonIn
       { _buttonIn_class = R.constDyn "addPayment"
       , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
@@ -100,6 +107,7 @@ payerAndAdd incomes payments users categories paymentCategories currency = do
       , _buttonIn_tabIndex = Nothing
       , _buttonIn_submit = False
       })
+
     rec
       modalOut <- Component.modal $ ModalIn
         { _modalIn_show    = addPaymentClic
-- 
cgit v1.2.3


From fb8f0fe577e28dae69903413b761da50586e0099 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 14:53:41 +0200
Subject: Remove payment category if unused after a payment is deleted

---
 client/src/View/Payment/Add.hs    |  3 +--
 client/src/View/Payment/Delete.hs | 35 ++++++++++++++++++-----------------
 client/src/View/Payment/Table.hs  | 12 +++++-------
 3 files changed, 24 insertions(+), 26 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index e0772f7..bd10e5a 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -23,7 +23,6 @@ import           Common.Model              (Category (..), CategoryId,
                                             CreatedPayment (..), Frequency (..),
                                             Payment (..), PaymentCategory (..))
 import qualified Common.Msg                as Msg
-import qualified Common.Util.Text          as Text
 import qualified Common.Util.Time          as Time
 import qualified Common.Validation.Payment as PaymentValidation
 import           Component                 (ButtonIn (..), InputIn (..),
@@ -168,4 +167,4 @@ view addIn = do
 findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
 findCategory paymentName =
   fmap _paymentCategory_category
-    . L.find ((==) (Text.formatSearch paymentName) . _paymentCategory_name)
+    . L.find ((==) (T.toLower paymentName) . _paymentCategory_name)
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 4aa10f3..65ce660 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -4,26 +4,26 @@ module View.Payment.Delete
   , DeleteOut(..)
   ) 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 (PaymentId)
-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
+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_id :: Dynamic t PaymentId
+  { _deleteIn_payment :: Dynamic t Payment
   }
 
 data DeleteOut t = DeleteOut
   { _deleteOut_cancel   :: Event t ()
-  , _deleteOut_validate :: Event t PaymentId
+  , _deleteOut_validate :: Event t Payment
   }
 
 view :: forall t m. MonadWidget t m => (DeleteIn t) -> m (DeleteOut t)
@@ -47,8 +47,9 @@ view deleteIn =
               , _buttonIn_waiting = waiting
               })
 
-          let url = flip fmap (_deleteIn_id deleteIn) (\id ->
-                  T.concat ["/payment/", T.pack . show $ id]
+          let url =
+                R.ffor (_deleteIn_payment deleteIn) (\id ->
+                  T.concat ["/payment/", T.pack . show $ _payment_id id]
                 )
 
           (result, waiting) <- WaitFor.waitFor
@@ -59,5 +60,5 @@ view deleteIn =
 
       return DeleteOut
         { _deleteOut_cancel = cancel
-        , _deleteOut_validate = R.tag (R.current $ _deleteIn_id deleteIn) deletedPayment
+        , _deleteOut_validate = R.tag (R.current $ _deleteIn_payment deleteIn) deletedPayment
         }
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index cdc4bb3..b09f30f 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -13,11 +13,9 @@ import           Reflex.Dom          (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom          as R
 
 import           Common.Model        (Category (..), Init (..), Payment (..),
-                                      PaymentCategory (..), PaymentId,
-                                      User (..))
+                                      PaymentCategory (..), User (..))
 import qualified Common.Model        as CM
 import qualified Common.Msg          as Msg
-import qualified Common.Util.Text    as T
 import qualified Common.View.Format  as Format
 import           Component           (ButtonIn (..), ButtonOut (..),
                                       ModalIn (..), ModalOut (..))
@@ -37,7 +35,7 @@ data TableIn t = TableIn
   }
 
 data TableOut t = TableOut
-  { _tableOut_deletePayment :: Event t PaymentId
+  { _tableOut_deletePayment :: Event t Payment
   }
 
 widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
@@ -84,7 +82,7 @@ paymentRow
   => Init
   -> Dynamic t [PaymentCategory]
   -> Dynamic t Payment
-  -> m (Event t PaymentId)
+  -> m (Event t Payment)
 paymentRow init paymentCategories payment =
   R.divClass "row" $ do
 
@@ -151,13 +149,13 @@ paymentRow init paymentCategories payment =
             [ _deleteOut_cancel . _modalOut_content $ modalOut
             , fmap (const ()) . _deleteOut_validate . _modalOut_content $ modalOut
             ]
-        , _modalIn_content = Delete.view (DeleteIn { _deleteIn_id = fmap _payment_id payment })
+        , _modalIn_content = Delete.view (DeleteIn { _deleteIn_payment = payment })
         }
     return (_deleteOut_validate . _modalOut_content $ modalOut)
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
   paymentCategory <- L.find
-    ((== T.formatSearch paymentName) . _paymentCategory_name)
+    ((== T.toLower paymentName) . _paymentCategory_name)
     paymentCategories
   L.find ((== (_paymentCategory_category paymentCategory)) . _category_id) categories
-- 
cgit v1.2.3


From 234b5b29361734656dc780148309962f932d9907 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 15:07:11 +0200
Subject: Use select component in payment search line

---
 client/src/View/Payment/Header.hs | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 73517f0..7a85493 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -28,7 +28,8 @@ import qualified Common.View.Format     as Format
 
 import           Component              (ButtonIn (..), ButtonOut (..),
                                          InputIn (..), InputOut (..),
-                                         ModalIn (..), ModalOut (..))
+                                         ModalIn (..), ModalOut (..),
+                                         SelectIn (..), SelectOut (..))
 import qualified Component              as Component
 import qualified Util.List              as L
 import           View.Payment.Add       (AddIn (..), AddOut (..))
@@ -140,8 +141,16 @@ searchLine reset = do
           , (Monthly, Msg.get Msg.Payment_MonthlyMale)
           ]
 
-    searchFrequency <- R._dropdown_value <$>
-      R.dropdown Punctual (R.constDyn frequencies) R.def
+    searchFrequency <- _selectOut_raw <$> (Component.select $
+      SelectIn
+        { _selectIn_label        = ""
+        , _selectIn_initialValue = Punctual
+        , _selectIn_value        = R.never
+        , _selectIn_values       = R.constDyn frequencies
+        , _selectIn_reset        = R.never
+        , _selectIn_isValid      = const True
+        , _selectIn_validate     = R.never
+        })
 
     return (searchName, searchFrequency)
 
-- 
cgit v1.2.3


From c5c54722f4736108c8418c9865f81f05a6db560d Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 15:29:56 +0200
Subject: Fix payment add frequency to the one selected in the page

---
 client/src/View/Payment/Add.hs    | 15 +++------------
 client/src/View/Payment/Header.hs | 23 +++++++++++++++++------
 2 files changed, 20 insertions(+), 18 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index bd10e5a..d2d2dc4 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -37,6 +37,7 @@ 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 ()
   }
 
@@ -92,16 +93,6 @@ view addIn = do
           (const currentDay <$> reset)
           confirm)
 
-        frequency <- _selectOut_value <$> (Component.select $ SelectIn
-          { _selectIn_label = Msg.get Msg.Payment_Frequency
-          , _selectIn_initialValue = Punctual
-          , _selectIn_value = R.never
-          , _selectIn_values = R.constDyn frequencies
-          , _selectIn_reset = reset
-          , _selectIn_isValid = const True
-          , _selectIn_validate = confirm
-          })
-
         let setCategory =
               R.fmapMaybe id
                 . R.updated
@@ -122,13 +113,13 @@ view addIn = do
               c <- cost
               d <- date
               cat <- category
-              f <- frequency
+              f <- _addIn_frequency addIn
               return (CreatePayment
                 <$> ValidationUtil.nelError n
                 <*> ValidationUtil.nelError c
                 <*> ValidationUtil.nelError d
                 <*> ValidationUtil.nelError cat
-                <*> ValidationUtil.nelError f)
+                <*> V.Success f)
 
         (addPayment, cancel, confirm) <- R.divClass "buttons" $ do
           rec
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 7a85493..fa21731 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -51,11 +51,20 @@ data HeaderOut t = HeaderOut
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
-    addPayment <- payerAndAdd incomes payments users categories paymentCategories currency
-    let resetSearchName = fmap (const ()) $ addPayment
-    (searchName, searchFrequency)  <- searchLine resetSearchName
-
-    infos (_headerIn_searchPayments headerIn) users currency
+    rec
+      addPayment <-
+        payerAndAdd
+          incomes
+          payments
+          users
+          categories
+          paymentCategories
+          currency
+          searchFrequency
+      let resetSearchName = fmap (const ()) $ addPayment
+      (searchName, searchFrequency)  <- searchLine resetSearchName
+
+      infos (_headerIn_searchPayments headerIn) users currency
 
     return $ HeaderOut
       { _headerOut_searchName = searchName
@@ -80,8 +89,9 @@ payerAndAdd
   -> [Category]
   -> Dynamic t [PaymentCategory]
   -> Currency
+  -> Dynamic t Frequency
   -> m (Event t CreatedPayment)
-payerAndAdd incomes payments users categories paymentCategories currency = do
+payerAndAdd incomes payments users categories paymentCategories currency frequency = do
   time <- liftIO Time.getCurrentTime
   R.divClass "payerAndAdd" $ do
 
@@ -119,6 +129,7 @@ payerAndAdd incomes payments users categories paymentCategories currency = do
         , _modalIn_content = Add.view $ AddIn
             { _addIn_categories = categories
             , _addIn_paymentCategories = paymentCategories
+            , _addIn_frequency = frequency
             , _addIn_cancel = _modalOut_hide modalOut
             }
         }
-- 
cgit v1.2.3


From c542424b7b41c78a170763f6996c12f56b359860 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 21:31:27 +0200
Subject: Add smooth transitions to modal show and hide

---
 client/src/View/Payment/Add.hs    | 8 ++++----
 client/src/View/Payment/Header.hs | 2 +-
 2 files changed, 5 insertions(+), 5 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index d2d2dc4..69e29a7 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -55,9 +55,9 @@ view addIn = do
     R.divClass "addContent" $ do
       rec
         let reset = R.leftmost
-              [ const "" <$> cancel
-              , const "" <$> addPayment
-              , const "" <$> _addIn_cancel addIn
+              [ "" <$ cancel
+              , "" <$ addPayment
+              , "" <$ _addIn_cancel addIn
               ]
 
         name <- Component.input
@@ -90,7 +90,7 @@ view addIn = do
             , _inputIn_hasResetButton = False
             , _inputIn_validation = PaymentValidation.date
             })
-          (const currentDay <$> reset)
+          (currentDay <$ reset)
           confirm)
 
         let setCategory =
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index fa21731..1bdee8d 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -144,7 +144,7 @@ searchLine reset = do
   R.divClass "searchLine" $ do
     searchName <- _inputOut_raw <$> (Component.input
       ( Component.defaultInputIn { _inputIn_label = Msg.get Msg.Search_Name })
-      (const "" <$> reset)
+      ("" <$ reset)
       R.never)
 
     let frequencies = M.fromList
-- 
cgit v1.2.3


From 2d79ab0e0a11f55255fc21a5dfab1598d3beeba3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 11 Aug 2019 22:40:09 +0200
Subject: Add payment clone

---
 client/src/View/Payment/Add.hs    | 187 ++++++++------------------------------
 client/src/View/Payment/Clone.hs  |  60 ++++++++++++
 client/src/View/Payment/Delete.hs |  57 ++++++------
 client/src/View/Payment/Edit.hs   |  55 +++++++++++
 client/src/View/Payment/Form.hs   | 165 +++++++++++++++++++++++++++++++++
 client/src/View/Payment/Header.hs |  39 +++-----
 client/src/View/Payment/Pages.hs  |  14 +--
 client/src/View/Payment/Table.hs  | 109 ++++++++++++++++------
 8 files changed, 447 insertions(+), 239 deletions(-)
 create mode 100644 client/src/View/Payment/Clone.hs
 create mode 100644 client/src/View/Payment/Edit.hs
 create mode 100644 client/src/View/Payment/Form.hs

(limited to 'client/src/View/Payment')

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
-- 
cgit v1.2.3


From f4c5df9e1b1afddeb5a482d4fbe654d0b321159c Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 6 Oct 2019 19:28:54 +0200
Subject: Make payment edition to work on the frontend

---
 client/src/View/Payment/Add.hs   |  1 +
 client/src/View/Payment/Clone.hs |  1 +
 client/src/View/Payment/Edit.hs  |  1 +
 client/src/View/Payment/Form.hs  | 19 ++++++++++++++-----
 client/src/View/Payment/Table.hs | 13 ++++++++-----
 5 files changed, 25 insertions(+), 10 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 88806bc..e83dba9 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -46,6 +46,7 @@ view input cancel = do
       , Form._input_category = -1
       , Form._input_frequency = frequency
       , Form._input_mkPayload = CreatePayment
+      , Form._input_httpMethod = Form.Post
       }
 
   hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 5624f6c..922e89c 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -49,6 +49,7 @@ view input cancel = do
       , Form._input_category = category
       , Form._input_frequency = _payment_frequency payment
       , Form._input_mkPayload = CreatePayment
+      , Form._input_httpMethod = Form.Post
       }
 
   hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Edit.hs b/client/src/View/Payment/Edit.hs
index 5020e57..9c11af0 100644
--- a/client/src/View/Payment/Edit.hs
+++ b/client/src/View/Payment/Edit.hs
@@ -44,6 +44,7 @@ view input cancel = do
       , Form._input_category = category
       , Form._input_frequency = _payment_frequency payment
       , Form._input_mkPayload = EditPayment (_payment_id payment)
+      , Form._input_httpMethod = Form.Put
       }
 
   hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index ba54957..9889638 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -1,6 +1,7 @@
 module View.Payment.Form
   ( view
   , Input(..)
+  , HttpMethod(..)
   , Output(..)
   ) where
 
@@ -46,8 +47,11 @@ data Input t p = Input
   , _input_category          :: CategoryId
   , _input_frequency         :: Frequency
   , _input_mkPayload         :: Text -> Int -> Day -> CategoryId -> Frequency -> p
+  , _input_httpMethod        :: HttpMethod
   }
 
+data HttpMethod = Put | Post
+
 data Output t = Output
   { _output_hide       :: Event t ()
   , _output_addPayment :: Event t SavedPayment
@@ -139,7 +143,7 @@ view input = do
                 })
 
             (addPayment, waiting) <- WaitFor.waitFor
-              (Ajax.postJson "/payment")
+              (ajax "/payment")
               (ValidationUtil.fireValidation payment confirm)
 
           return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, confirm)
@@ -150,14 +154,19 @@ view input = do
         }
 
   where
-    frequencies = M.fromList
-      [ (Punctual, Msg.get Msg.Payment_PunctualMale)
-      , (Monthly, Msg.get Msg.Payment_MonthlyMale)
-      ]
+    frequencies =
+      M.fromList
+        [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+        , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+        ]
 
     categories = M.fromList . flip map (_input_categories input) $ \c ->
       (_category_id c, _category_name c)
 
+    ajax =
+      case _input_httpMethod input of
+        Post -> Ajax.postJson
+        Put  -> Ajax.putJson
 
 findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
 findCategory paymentName =
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index f2b8870..40bc864 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -44,6 +44,7 @@ data TableIn t = TableIn
 
 data TableOut t = TableOut
   { _tableOut_addPayment    :: Event t SavedPayment
+  , _tableOut_editPayment   :: Event t SavedPayment
   , _tableOut_deletePayment :: Event t Payment
   }
 
@@ -51,7 +52,7 @@ widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
 widget tableIn = do
   R.divClass "table" $ do
 
-    (addPayment, deletePayment) <- R.divClass "lines" $ do
+    (addPayment, editPayment, deletePayment) <- R.divClass "lines" $ do
       R.divClass "header" $ do
         R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
         R.divClass "cell cost" $ R.text $ Msg.get Msg.Payment_Cost
@@ -66,8 +67,9 @@ widget tableIn = do
         (R.simpleList paymentRange (paymentRow init paymentCategories))
 
       return $
-        ( R.switch . R.current . fmap (R.leftmost . map fst) $ result
-        , R.switch . R.current . fmap (R.leftmost . map snd) $ result
+        ( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
+        , R.switch . R.current . fmap (R.leftmost . map (\(_, b, _) -> b)) $ result
+        , R.switch . R.current . fmap (R.leftmost . map (\(_, _, c) -> c)) $ result
         )
 
     ReflexUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
@@ -75,6 +77,7 @@ widget tableIn = do
 
     return $ TableOut
       { _tableOut_addPayment = addPayment
+      , _tableOut_editPayment = editPayment
       , _tableOut_deletePayment = deletePayment
       }
 
@@ -98,7 +101,7 @@ paymentRow
   => Init
   -> Dynamic t [PaymentCategory]
   -> Dynamic t Payment
-  -> m (Event t SavedPayment, Event t Payment)
+  -> m (Event t SavedPayment, Event t SavedPayment, Event t Payment)
 paymentRow init paymentCategories payment =
   R.divClass "row" $ do
 
@@ -200,7 +203,7 @@ paymentRow init paymentCategories payment =
               }
         }
 
-    return $ (paymentCloned, paymentDeleted)
+    return $ (paymentCloned, paymentEdited, paymentDeleted)
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
-- 
cgit v1.2.3


From 7529a18ff0ac443e7f9764b5e2d0f57a5d3a850b Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 9 Oct 2019 23:16:00 +0200
Subject: Use common payment validation in the backend

Remove deprecated backend validation
---
 client/src/View/Payment/Add.hs    | 35 +++++++++++++++++------------------
 client/src/View/Payment/Clone.hs  | 35 +++++++++++++++++------------------
 client/src/View/Payment/Edit.hs   | 27 +++++++++++++--------------
 client/src/View/Payment/Form.hs   | 12 ++++++------
 client/src/View/Payment/Header.hs |  3 ++-
 5 files changed, 55 insertions(+), 57 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index e83dba9..28c0148 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -3,23 +3,22 @@ module View.Payment.Add
   , Input(..)
   ) 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 (..), 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
+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.Reflex            as ReflexUtil
+import qualified View.Payment.Form      as Form
 
 data Input t = Input
   { _input_categories        :: [Category]
@@ -45,7 +44,7 @@ view input cancel = do
       , Form._input_date = currentDay
       , Form._input_category = -1
       , Form._input_frequency = frequency
-      , Form._input_mkPayload = CreatePayment
+      , Form._input_mkPayload = CreatePaymentForm
       , Form._input_httpMethod = Form.Post
       }
 
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 922e89c..60694ca 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -3,23 +3,22 @@ module View.Payment.Clone
   , 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
+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.Reflex            as ReflexUtil
+import qualified View.Payment.Form      as Form
 
 data Input t = Input
   { _input_show              :: Event t ()
@@ -48,7 +47,7 @@ view input cancel = do
       , Form._input_date = currentDay
       , Form._input_category = category
       , Form._input_frequency = _payment_frequency payment
-      , Form._input_mkPayload = CreatePayment
+      , Form._input_mkPayload = CreatePaymentForm
       , Form._input_httpMethod = Form.Post
       }
 
diff --git a/client/src/View/Payment/Edit.hs b/client/src/View/Payment/Edit.hs
index 9c11af0..0361602 100644
--- a/client/src/View/Payment/Edit.hs
+++ b/client/src/View/Payment/Edit.hs
@@ -3,20 +3,19 @@ module View.Payment.Edit
   , 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 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
+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.Reflex       as ReflexUtil
+import qualified View.Payment.Form as Form
 
 data Input t = Input
   { _input_show              :: Event t ()
@@ -43,7 +42,7 @@ view input cancel = do
       , Form._input_date = _payment_date payment
       , Form._input_category = category
       , Form._input_frequency = _payment_frequency payment
-      , Form._input_mkPayload = EditPayment (_payment_id payment)
+      , Form._input_mkPayload = EditPaymentForm (_payment_id payment)
       , Form._input_httpMethod = Form.Put
       }
 
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 9889638..187b64b 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -46,7 +46,7 @@ data Input t p = Input
   , _input_date              :: Day
   , _input_category          :: CategoryId
   , _input_frequency         :: Frequency
-  , _input_mkPayload         :: Text -> Int -> Day -> CategoryId -> Frequency -> p
+  , _input_mkPayload         :: Text -> Text -> Text -> CategoryId -> Frequency -> p
   , _input_httpMethod        :: HttpMethod
   }
 
@@ -80,7 +80,7 @@ view input = do
           (_input_name input <$ reset)
           confirm
 
-        cost <- _inputOut_value <$> (Component.input
+        cost <- _inputOut_raw <$> (Component.input
           (Component.defaultInputIn
             { _inputIn_label = Msg.get Msg.Payment_Cost
             , _inputIn_initialValue = _input_cost input
@@ -91,7 +91,7 @@ view input = do
 
         let initialDate = T.pack . Calendar.showGregorian . _input_date $ input
 
-        date <- _inputOut_value <$> (Component.input
+        date <- _inputOut_raw <$> (Component.input
           (Component.defaultInputIn
             { _inputIn_label = Msg.get Msg.Payment_Date
             , _inputIn_initialValue = initialDate
@@ -113,7 +113,7 @@ view input = do
           , _selectIn_value = setCategory
           , _selectIn_values = R.constDyn categories
           , _selectIn_reset = _input_category input <$ reset
-          , _selectIn_isValid = (/= -1)
+          , _selectIn_isValid = PaymentValidation.category (map _category_id $ _input_categories input)
           , _selectIn_validate = confirm
           })
 
@@ -124,8 +124,8 @@ view input = do
               cat <- category
               return ((_input_mkPayload input)
                 <$> ValidationUtil.nelError n
-                <*> ValidationUtil.nelError c
-                <*> ValidationUtil.nelError d
+                <*> V.Success c
+                <*> V.Success d
                 <*> ValidationUtil.nelError cat
                 <*> V.Success (_input_frequency input))
 
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 7281195..6ed3b0e 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -13,6 +13,7 @@ import           Data.Text              (Text)
 import qualified Data.Text              as T
 import           Data.Time              (NominalDiffTime)
 import qualified Data.Time              as Time
+import qualified Data.Validation        as V
 import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
@@ -150,7 +151,7 @@ searchLine reset = do
         , _selectIn_value        = R.never
         , _selectIn_values       = R.constDyn frequencies
         , _selectIn_reset        = R.never
-        , _selectIn_isValid      = const True
+        , _selectIn_isValid      = V.Success
         , _selectIn_validate     = R.never
         })
 
-- 
cgit v1.2.3


From 52331eeadce8d250564851c25fc965172640bc55 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 12 Oct 2019 11:23:10 +0200
Subject: Implement client routing

---
 client/src/View/Payment/Delete.hs | 2 +-
 client/src/View/Payment/Form.hs   | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index e7e319e..521c1a7 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -44,7 +44,7 @@ view input _ =
 
           let url =
                 R.ffor (_input_payment input) (\id ->
-                  T.concat ["/payment/", T.pack . show $ _payment_id id]
+                  T.concat ["/api/payment/", T.pack . show $ _payment_id id]
                 )
 
           (result, waiting) <- WaitFor.waitFor
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 187b64b..7819836 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -143,7 +143,7 @@ view input = do
                 })
 
             (addPayment, waiting) <- WaitFor.waitFor
-              (ajax "/payment")
+              (ajax "/api/payment")
               (ValidationUtil.fireValidation payment confirm)
 
           return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, confirm)
-- 
cgit v1.2.3


From 04c59f08f100ba6a0658d1f2b357f7d8b1e14218 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 13 Oct 2019 22:38:35 +0200
Subject: Show income table

---
 client/src/View/Payment/Payment.hs | 154 +++++++++++++++++++++++++++++++++++++
 client/src/View/Payment/Table.hs   |   3 -
 2 files changed, 154 insertions(+), 3 deletions(-)
 create mode 100644 client/src/View/Payment/Payment.hs

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
new file mode 100644
index 0000000..cfdb441
--- /dev/null
+++ b/client/src/View/Payment/Payment.hs
@@ -0,0 +1,154 @@
+module View.Payment.Payment
+  ( view
+  , PaymentIn(..)
+  ) 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        (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
+import           View.Payment.Pages  (PagesIn (..), PagesOut (..))
+import qualified View.Payment.Pages  as Pages
+import           View.Payment.Table  (TableIn (..), TableOut (..))
+import qualified View.Payment.Table  as Table
+
+data PaymentIn = PaymentIn
+  { _paymentIn_init :: Init
+  }
+
+view :: forall t m. MonadWidget t m => PaymentIn -> m ()
+view paymentIn = do
+  R.elClass "main" "payment" $ do
+    rec
+      let init = _paymentIn_init paymentIn
+
+          paymentsPerPage = 7
+
+          addPayment = R.leftmost
+            [ _headerOut_addPayment header
+            , _tableOut_addPayment table
+            ]
+
+      payments <- reducePayments
+        (_init_payments init)
+        (_savedPayment_payment <$> addPayment)
+        (_savedPayment_payment <$> _tableOut_editPayment table)
+        (_tableOut_deletePayment table)
+
+      paymentCategories <- reducePaymentCategories
+        (_init_paymentCategories init)
+        payments
+        (_savedPayment_paymentCategory <$> addPayment)
+        (_savedPayment_paymentCategory <$> _tableOut_editPayment table)
+        (_tableOut_deletePayment table)
+
+      (searchNameEvent, searchName) <-
+        debounceSearchName (_headerOut_searchName header)
+
+      let searchPayments =
+            getSearchPayments searchName (_headerOut_searchFrequency header) payments
+
+      header <- Header.widget $ HeaderIn
+        { _headerIn_init = init
+        , _headerIn_payments = payments
+        , _headerIn_searchPayments = searchPayments
+        , _headerIn_paymentCategories = paymentCategories
+        }
+
+      table <- Table.widget $ TableIn
+        { _tableIn_init = init
+        , _tableIn_currentPage = _pagesOut_currentPage pages
+        , _tableIn_payments = searchPayments
+        , _tableIn_perPage = paymentsPerPage
+        , _tableIn_paymentCategories = paymentCategories
+        }
+
+      pages <- Pages.widget $ PagesIn
+        { _pagesIn_total = length <$> searchPayments
+        , _pagesIn_perPage = paymentsPerPage
+        , _pagesIn_reset = R.leftmost $
+            [ () <$ searchNameEvent
+            , () <$ _headerOut_addPayment header
+            ]
+        }
+
+    pure ()
+
+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/Table.hs b/client/src/View/Payment/Table.hs
index 40bc864..bf6b604 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -30,9 +30,6 @@ import qualified View.Payment.Edit   as Edit
 import qualified Icon
 import qualified Util.Reflex         as ReflexUtil
 
--- TODO: remove
-import           Debug.Trace         (trace)
-
 data TableIn t = TableIn
   { _tableIn_init              :: Init
   , _tableIn_currentPage       :: Dynamic t Int
-- 
cgit v1.2.3


From 7aadcc97f9df0e2daccbe8a8726d8bc6c63d67f4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 20 Oct 2019 12:02:21 +0200
Subject: Add income

---
 client/src/View/Payment/Delete.hs |  1 +
 client/src/View/Payment/Header.hs | 14 ++++++--------
 2 files changed, 7 insertions(+), 8 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 521c1a7..dc7e395 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -13,6 +13,7 @@ import qualified Common.Msg      as Msg
 import           Component       (ButtonIn (..), ButtonOut (..))
 import qualified Component       as Component
 import qualified Component.Modal as Modal
+import qualified Component.Modal as Modal
 import qualified Util.Ajax       as Ajax
 import qualified Util.Either     as EitherUtil
 import qualified Util.WaitFor    as WaitFor
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 6ed3b0e..9db4c7c 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -111,16 +111,14 @@ payerAndAdd incomes payments users categories paymentCategories currency frequen
             R.dynText . R.ffor exceedingPayer $ \ep ->
               Format.price currency $ _exceedingPayer_amount ep
 
-    addPaymentClic <- _buttonOut_clic <$> (Component.button $ ButtonIn
-      { _buttonIn_class = R.constDyn "addPayment"
-      , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
-      , _buttonIn_waiting = R.never
-      , _buttonIn_tabIndex = Nothing
-      , _buttonIn_submit = False
-      })
+    addPayment <- _buttonOut_clic <$>
+      (Component.button $
+        (Component.defaultButtonIn (R.text $ Msg.get Msg.Payment_Add))
+          { _buttonIn_class = R.constDyn "addPayment"
+          })
 
     Modal.view $ Modal.Input
-      { Modal._input_show    = addPaymentClic
+      { Modal._input_show    = addPayment
       , Modal._input_content = Add.view $ Add.Input
           { Add._input_categories = categories
           , Add._input_paymentCategories = paymentCategories
-- 
cgit v1.2.3


From 602c52acfcfa494b07fec05c20b317b60ea8a6f3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 20 Oct 2019 21:31:57 +0200
Subject: Load init data per page with AJAX

---
 client/src/View/Payment/Form.hs    |   4 +-
 client/src/View/Payment/Header.hs  |   6 +-
 client/src/View/Payment/Init.hs    |  13 +++
 client/src/View/Payment/Payment.hs | 165 +++++++++++++++++++++++--------------
 client/src/View/Payment/Table.hs   |  21 +++--
 5 files changed, 136 insertions(+), 73 deletions(-)
 create mode 100644 client/src/View/Payment/Init.hs

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 7819836..c817831 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -165,8 +165,8 @@ view input = do
 
     ajax =
       case _input_httpMethod input of
-        Post -> Ajax.postJson
-        Put  -> Ajax.putJson
+        Post -> Ajax.post
+        Put  -> Ajax.put
 
 findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
 findCategory paymentName =
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 9db4c7c..9ad90a9 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -20,7 +20,7 @@ import qualified Reflex.Dom             as R
 
 import           Common.Model           (Category, Currency,
                                          ExceedingPayer (..), Frequency (..),
-                                         Income (..), Init (..), Payment (..),
+                                         Income (..), Payment (..),
                                          PaymentCategory, SavedPayment (..),
                                          User (..))
 import qualified Common.Model           as CM
@@ -34,9 +34,11 @@ import qualified Component              as Component
 import qualified Component.Modal        as Modal
 import qualified Util.List              as L
 import qualified View.Payment.Add       as Add
+import           View.Payment.Init      (Init (..))
 
 data HeaderIn t = HeaderIn
   { _headerIn_init              :: Init
+  , _headerIn_currency          :: Currency
   , _headerIn_payments          :: Dynamic t [Payment]
   , _headerIn_searchPayments    :: Dynamic t [Payment]
   , _headerIn_paymentCategories :: Dynamic t [PaymentCategory]
@@ -78,7 +80,7 @@ widget headerIn =
     payments = _headerIn_payments headerIn
     users = _init_users init
     categories = _init_categories init
-    currency = _init_currency init
+    currency = _headerIn_currency headerIn
     paymentCategories = _headerIn_paymentCategories headerIn
 
 payerAndAdd
diff --git a/client/src/View/Payment/Init.hs b/client/src/View/Payment/Init.hs
new file mode 100644
index 0000000..d9f85c8
--- /dev/null
+++ b/client/src/View/Payment/Init.hs
@@ -0,0 +1,13 @@
+module View.Payment.Init
+  ( Init(..)
+  ) where
+
+import           Common.Model (Category, Income, Payment, PaymentCategory, User)
+
+data Init = Init
+  { _init_users             :: [User]
+  , _init_payments          :: [Payment]
+  , _init_incomes           :: [Income]
+  , _init_categories        :: [Category]
+  , _init_paymentCategories :: [PaymentCategory]
+  } deriving (Show)
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index cfdb441..ec350e2 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -1,5 +1,6 @@
 module View.Payment.Payment
-  ( view
+  ( init
+  , view
   , PaymentIn(..)
   ) where
 
@@ -10,78 +11,118 @@ import           Prelude             hiding (init)
 import           Reflex.Dom          (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom          as R
 
-import           Common.Model        (Frequency, Init (..), Payment (..),
-                                      PaymentCategory (..), PaymentId,
-                                      SavedPayment (..))
+import           Common.Model        (Currency, Frequency, Income (..),
+                                      Payment (..), PaymentCategory (..),
+                                      PaymentId, SavedPayment (..), User,
+                                      UserId)
 import qualified Common.Util.Text    as T
+
+import           Model.Loadable      (Loadable (..))
+import qualified Model.Loadable      as Loadable
+import qualified Util.Ajax           as AjaxUtil
 import           View.Payment.Header (HeaderIn (..), HeaderOut (..))
 import qualified View.Payment.Header as Header
+import           View.Payment.Init   (Init (..))
 import           View.Payment.Pages  (PagesIn (..), PagesOut (..))
 import qualified View.Payment.Pages  as Pages
 import           View.Payment.Table  (TableIn (..), TableOut (..))
 import qualified View.Payment.Table  as Table
 
-data PaymentIn = PaymentIn
-  { _paymentIn_init :: Init
+init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init))
+init = do
+  postBuild <- R.getPostBuild
+
+  incomesEvent <- AjaxUtil.get (R.tag (R.constant "api/incomes") postBuild)
+  incomes <- Loadable.fromEvent incomesEvent
+
+  usersEvent <- AjaxUtil.get (R.tag (R.constant "api/users") postBuild)
+  users <- Loadable.fromEvent usersEvent
+
+  paymentsEvent <- AjaxUtil.get (R.tag (R.constant "api/payments") postBuild)
+  payments <- Loadable.fromEvent paymentsEvent
+
+  paymentCategoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/paymentCategories") postBuild)
+  paymentCategories <- Loadable.fromEvent paymentCategoriesEvent
+
+  categoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/categories") postBuild)
+  categories <- Loadable.fromEvent categoriesEvent
+
+  return $ do
+    us <- users
+    ps <- payments
+    is <- incomes
+    cs <- categories
+    pcs <- paymentCategories
+    return $ Init <$> us <*> ps <*> is <*> cs <*> pcs
+
+data PaymentIn t = PaymentIn
+  { _paymentIn_currentUser :: UserId
+  , _paymentIn_currency    :: Currency
+  , _paymentIn_init        :: Dynamic t (Loadable Init)
   }
 
-view :: forall t m. MonadWidget t m => PaymentIn -> m ()
+view :: forall t m. MonadWidget t m => PaymentIn t -> m ()
 view paymentIn = do
-  R.elClass "main" "payment" $ do
-    rec
-      let init = _paymentIn_init paymentIn
-
-          paymentsPerPage = 7
-
-          addPayment = R.leftmost
-            [ _headerOut_addPayment header
-            , _tableOut_addPayment table
-            ]
-
-      payments <- reducePayments
-        (_init_payments init)
-        (_savedPayment_payment <$> addPayment)
-        (_savedPayment_payment <$> _tableOut_editPayment table)
-        (_tableOut_deletePayment table)
-
-      paymentCategories <- reducePaymentCategories
-        (_init_paymentCategories init)
-        payments
-        (_savedPayment_paymentCategory <$> addPayment)
-        (_savedPayment_paymentCategory <$> _tableOut_editPayment table)
-        (_tableOut_deletePayment table)
-
-      (searchNameEvent, searchName) <-
-        debounceSearchName (_headerOut_searchName header)
-
-      let searchPayments =
-            getSearchPayments searchName (_headerOut_searchFrequency header) payments
-
-      header <- Header.widget $ HeaderIn
-        { _headerIn_init = init
-        , _headerIn_payments = payments
-        , _headerIn_searchPayments = searchPayments
-        , _headerIn_paymentCategories = paymentCategories
-        }
-
-      table <- Table.widget $ TableIn
-        { _tableIn_init = init
-        , _tableIn_currentPage = _pagesOut_currentPage pages
-        , _tableIn_payments = searchPayments
-        , _tableIn_perPage = paymentsPerPage
-        , _tableIn_paymentCategories = paymentCategories
-        }
-
-      pages <- Pages.widget $ PagesIn
-        { _pagesIn_total = length <$> searchPayments
-        , _pagesIn_perPage = paymentsPerPage
-        , _pagesIn_reset = R.leftmost $
-            [ () <$ searchNameEvent
-            , () <$ _headerOut_addPayment header
-            ]
-        }
-
-    pure ()
+  R.dyn . R.ffor (_paymentIn_init paymentIn) . Loadable.view $ \init ->
+
+    R.elClass "main" "payment" $ do
+      rec
+        let addPayment = R.leftmost
+              [ _headerOut_addPayment header
+              , _tableOut_addPayment table
+              ]
+
+            paymentsPerPage = 7
+
+        payments <- reducePayments
+          (_init_payments init)
+          (_savedPayment_payment <$> addPayment)
+          (_savedPayment_payment <$> _tableOut_editPayment table)
+          (_tableOut_deletePayment table)
+
+        paymentCategories <- reducePaymentCategories
+          (_init_paymentCategories init)
+          payments
+          (_savedPayment_paymentCategory <$> addPayment)
+          (_savedPayment_paymentCategory <$> _tableOut_editPayment table)
+          (_tableOut_deletePayment table)
+
+        (searchNameEvent, searchName) <-
+          debounceSearchName (_headerOut_searchName header)
+
+        let searchPayments =
+              getSearchPayments searchName (_headerOut_searchFrequency header) payments
+
+        header <- Header.widget $ HeaderIn
+          { _headerIn_init = init
+          , _headerIn_currency = _paymentIn_currency paymentIn
+          , _headerIn_payments = payments
+          , _headerIn_searchPayments = searchPayments
+          , _headerIn_paymentCategories = paymentCategories
+          }
+
+        table <- Table.widget $ TableIn
+          { _tableIn_init = init
+          , _tableIn_currency = _paymentIn_currency paymentIn
+          , _tableIn_currentUser = _paymentIn_currentUser paymentIn
+          , _tableIn_currentPage = _pagesOut_currentPage pages
+          , _tableIn_payments = searchPayments
+          , _tableIn_perPage = paymentsPerPage
+          , _tableIn_paymentCategories = paymentCategories
+          }
+
+        pages <- Pages.widget $ PagesIn
+          { _pagesIn_total = length <$> searchPayments
+          , _pagesIn_perPage = paymentsPerPage
+          , _pagesIn_reset = R.leftmost $
+              [ () <$ searchNameEvent
+              , () <$ _headerOut_addPayment header
+              ]
+          }
+
+      pure ()
+
+  return ()
 
 debounceSearchName
   :: forall t m. MonadWidget t m
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index bf6b604..5ffa037 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -13,10 +13,10 @@ import           Prelude             hiding (init)
 import           Reflex.Dom          (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom          as R
 
-import           Common.Model        (Category (..), Frequency (Punctual),
-                                      Init (..), Payment (..),
+import           Common.Model        (Category (..), Currency,
+                                      Frequency (Punctual), Payment (..),
                                       PaymentCategory (..), SavedPayment,
-                                      User (..))
+                                      User (..), UserId)
 import qualified Common.Model        as CM
 import qualified Common.Msg          as Msg
 import qualified Common.View.Format  as Format
@@ -26,12 +26,15 @@ 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 Icon
 import qualified Util.Reflex         as ReflexUtil
 
 data TableIn t = TableIn
   { _tableIn_init              :: Init
+  , _tableIn_currency          :: Currency
+  , _tableIn_currentUser       :: UserId
   , _tableIn_currentPage       :: Dynamic t Int
   , _tableIn_payments          :: Dynamic t [Payment]
   , _tableIn_perPage           :: Int
@@ -61,7 +64,7 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
 
       result <-
-        (R.simpleList paymentRange (paymentRow init paymentCategories))
+        (R.simpleList paymentRange (paymentRow init currency currentUser paymentCategories))
 
       return $
         ( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
@@ -80,6 +83,8 @@ widget tableIn = do
 
   where
     init = _tableIn_init tableIn
+    currency = _tableIn_currency tableIn
+    currentUser = _tableIn_currentUser tableIn
     currentPage = _tableIn_currentPage tableIn
     payments = _tableIn_payments tableIn
     paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage
@@ -96,17 +101,19 @@ getPaymentRange perPage payments currentPage =
 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 paymentCategories 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 (_init_currency init) . _payment_cost) payment
+      R.dynText $ fmap (Format.price currency . _payment_cost) payment
 
     let user = R.ffor payment (\p ->
           CM.findUser (_payment_user p) (_init_users init))
@@ -162,7 +169,7 @@ paymentRow init paymentCategories payment =
     let isFromCurrentUser =
           R.ffor
             payment
-            (\p -> _payment_user p == _init_currentUser init)
+            (\p -> _payment_user p == currentUser)
 
     editPayment <-
       R.divClass "cell button" $
-- 
cgit v1.2.3


From 33e78f2ebbf5bf7b40e7aa732cc7c019f6df3f12 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 20 Oct 2019 22:08:31 +0200
Subject: Simplify page initialization

---
 client/src/View/Payment/Pages.hs   |  2 +-
 client/src/View/Payment/Payment.hs | 27 ++++++++-------------------
 client/src/View/Payment/Table.hs   |  2 +-
 3 files changed, 10 insertions(+), 21 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 9247143..5681935 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -11,8 +11,8 @@ import qualified Reflex.Dom  as R
 import           Component   (ButtonIn (..), ButtonOut (..))
 import qualified Component   as Component
 
-import qualified Icon
 import qualified Util.Reflex as ReflexUtil
+import qualified View.Icon   as Icon
 
 data PagesIn t = PagesIn
   { _pagesIn_total   :: Dynamic t Int
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index ec350e2..5f0d03c 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -17,8 +17,8 @@ import           Common.Model        (Currency, Frequency, Income (..),
                                       UserId)
 import qualified Common.Util.Text    as T
 
-import           Model.Loadable      (Loadable (..))
-import qualified Model.Loadable      as Loadable
+import           Loadable            (Loadable (..))
+import qualified Loadable
 import qualified Util.Ajax           as AjaxUtil
 import           View.Payment.Header (HeaderIn (..), HeaderOut (..))
 import qualified View.Payment.Header as Header
@@ -30,23 +30,11 @@ import qualified View.Payment.Table  as Table
 
 init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init))
 init = do
-  postBuild <- R.getPostBuild
-
-  incomesEvent <- AjaxUtil.get (R.tag (R.constant "api/incomes") postBuild)
-  incomes <- Loadable.fromEvent incomesEvent
-
-  usersEvent <- AjaxUtil.get (R.tag (R.constant "api/users") postBuild)
-  users <- Loadable.fromEvent usersEvent
-
-  paymentsEvent <- AjaxUtil.get (R.tag (R.constant "api/payments") postBuild)
-  payments <- Loadable.fromEvent paymentsEvent
-
-  paymentCategoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/paymentCategories") postBuild)
-  paymentCategories <- Loadable.fromEvent paymentCategoriesEvent
-
-  categoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/categories") postBuild)
-  categories <- Loadable.fromEvent categoriesEvent
-
+  users <- AjaxUtil.getNow "api/users"
+  payments <- AjaxUtil.getNow "api/payments"
+  incomes <- AjaxUtil.getNow "api/incomes"
+  categories <- AjaxUtil.getNow "api/categories"
+  paymentCategories <- AjaxUtil.getNow "api/paymentCategories"
   return $ do
     us <- users
     ps <- payments
@@ -55,6 +43,7 @@ init = do
     pcs <- paymentCategories
     return $ Init <$> us <*> ps <*> is <*> cs <*> pcs
 
+
 data PaymentIn t = PaymentIn
   { _paymentIn_currentUser :: UserId
   , _paymentIn_currency    :: Currency
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 5ffa037..3a0a4bf 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -28,8 +28,8 @@ import qualified View.Payment.Delete as Delete
 import qualified View.Payment.Edit   as Edit
 import           View.Payment.Init   (Init (..))
 
-import qualified Icon
 import qualified Util.Reflex         as ReflexUtil
+import qualified View.Icon           as Icon
 
 data TableIn t = TableIn
   { _tableIn_init              :: Init
-- 
cgit v1.2.3


From 80f09e8b3a5c856e60922a73c9161a8c5392e4d4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 22 Oct 2019 21:35:03 +0200
Subject: Create ModalForm component

---
 client/src/View/Payment/Add.hs   |   3 +-
 client/src/View/Payment/Clone.hs |   3 +-
 client/src/View/Payment/Edit.hs  |   3 +-
 client/src/View/Payment/Form.hs  | 205 +++++++++++++++++----------------------
 4 files changed, 96 insertions(+), 118 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 28c0148..163a200 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -17,6 +17,7 @@ import           Common.Model           (Category (..), CreatePaymentForm (..),
 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
 
@@ -45,7 +46,7 @@ view input cancel = do
       , Form._input_category = -1
       , Form._input_frequency = frequency
       , Form._input_mkPayload = CreatePaymentForm
-      , Form._input_httpMethod = Form.Post
+      , Form._input_ajax = Ajax.post
       }
 
   hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 60694ca..2fa27f3 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -17,6 +17,7 @@ import           Common.Model           (Category (..), CategoryId,
 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
 
@@ -48,7 +49,7 @@ view input cancel = do
       , Form._input_category = category
       , Form._input_frequency = _payment_frequency payment
       , Form._input_mkPayload = CreatePaymentForm
-      , Form._input_httpMethod = Form.Post
+      , Form._input_ajax = Ajax.post
       }
 
   hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Edit.hs b/client/src/View/Payment/Edit.hs
index 0361602..77841ce 100644
--- a/client/src/View/Payment/Edit.hs
+++ b/client/src/View/Payment/Edit.hs
@@ -14,6 +14,7 @@ import           Common.Model      (Category (..), CategoryId,
                                     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
 
@@ -43,7 +44,7 @@ view input cancel = do
       , Form._input_category = category
       , Form._input_frequency = _payment_frequency payment
       , Form._input_mkPayload = EditPaymentForm (_payment_id payment)
-      , Form._input_httpMethod = Form.Put
+      , Form._input_ajax = Ajax.put
       }
 
   hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index c817831..1f068fd 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -1,23 +1,21 @@
 module View.Payment.Form
   ( view
   , Input(..)
-  , HttpMethod(..)
   , Output(..)
   ) where
 
-import           Control.Monad             (join)
-import           Control.Monad.IO.Class    (liftIO)
 import           Data.Aeson                (ToJSON)
 import qualified Data.List                 as L
+import           Data.List.NonEmpty        (NonEmpty)
 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           Data.Validation           (Validation)
 import qualified Data.Validation           as V
-import           Reflex.Dom                (Dynamic, Event, MonadHold,
-                                            MonadWidget, Reflex)
+import           Reflex.Dom                (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom                as R
 import qualified Text.Read                 as T
 
@@ -27,16 +25,13 @@ import           Common.Model              (Category (..), CategoryId,
                                             SavedPayment (..))
 import qualified Common.Msg                as Msg
 import qualified Common.Validation.Payment as PaymentValidation
-import           Component                 (ButtonIn (..), InputIn (..),
-                                            InputOut (..), SelectIn (..),
-                                            SelectOut (..))
+import           Component                 (InputIn (..), InputOut (..),
+                                            ModalFormIn (..), ModalFormOut (..),
+                                            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
+data Input m t a = Input
   { _input_cancel            :: Event t ()
   , _input_headerLabel       :: Text
   , _input_categories        :: [Category]
@@ -46,114 +41,99 @@ data Input t p = Input
   , _input_date              :: Day
   , _input_category          :: CategoryId
   , _input_frequency         :: Frequency
-  , _input_mkPayload         :: Text -> Text -> Text -> CategoryId -> Frequency -> p
-  , _input_httpMethod        :: HttpMethod
+  , _input_mkPayload         :: Text -> Text -> Text -> CategoryId -> Frequency -> a
+  , _input_ajax              :: Text -> Event t a -> m (Event t (Either Text SavedPayment))
   }
 
-data HttpMethod = Put | Post
-
 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 :: forall t m a. (MonadWidget t m, ToJSON a) => Input m t a -> 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_raw <$> (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_raw <$> (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 = PaymentValidation.category (map _category_id $ _input_categories input)
-          , _selectIn_validate = confirm
-          })
-
-        let payment = do
-              n <- _inputOut_value name
-              c <- cost
-              d <- date
-              cat <- category
-              return ((_input_mkPayload input)
-                <$> ValidationUtil.nelError n
-                <*> V.Success c
-                <*> V.Success 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 "/api/payment")
-              (ValidationUtil.fireValidation payment confirm)
-
-          return (R.fmapMaybe EitherUtil.eitherToMaybe addPayment, cancel, confirm)
-
-      return Output
-        { _output_hide = R.leftmost [ cancel, () <$ addPayment ]
-        , _output_addPayment = addPayment
-        }
+  rec
+    let reset = R.leftmost
+          [ "" <$ _modalFormOut_cancel modalForm
+          , "" <$ _modalFormOut_validate modalForm
+          , "" <$ _input_cancel input
+          ]
+
+    modalForm <- Component.modalForm $ ModalFormIn
+      { _modalFormIn_headerLabel = _input_headerLabel input
+      , _modalFormIn_ajax        = _input_ajax input "/api/payment"
+      , _modalFormIn_form        = form reset (_modalFormOut_confirm modalForm)
+      }
+
+  return $ Output
+    { _output_hide = _modalFormOut_hide modalForm
+    , _output_addPayment = _modalFormOut_validate modalForm
+    }
 
   where
+    form
+      :: Event t String
+      -> Event t ()
+      -> m (Dynamic t (Validation (NonEmpty Text) a))
+    form reset confirm = do
+      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_raw <$> (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_raw <$> (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 = PaymentValidation.category (map _category_id $ _input_categories input)
+        , _selectIn_validate = confirm
+        })
+
+      return $ do
+        n <- _inputOut_value name
+        c <- cost
+        d <- date
+        cat <- category
+        return ((_input_mkPayload input)
+          <$> ValidationUtil.nelError n
+          <*> V.Success c
+          <*> V.Success d
+          <*> ValidationUtil.nelError cat
+          <*> V.Success (_input_frequency input))
+
     frequencies =
       M.fromList
         [ (Punctual, Msg.get Msg.Payment_PunctualMale)
@@ -163,11 +143,6 @@ view input = do
     categories = M.fromList . flip map (_input_categories input) $ \c ->
       (_category_id c, _category_name c)
 
-    ajax =
-      case _input_httpMethod input of
-        Post -> Ajax.post
-        Put  -> Ajax.put
-
 findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
 findCategory paymentName =
   fmap _paymentCategory_category
-- 
cgit v1.2.3


From 613ffccac4b3ab25c6d4c631fab757da0b35acf6 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 22 Oct 2019 22:26:38 +0200
Subject: Harmonize view component code style

---
 client/src/View/Payment/Add.hs     |  40 ++++++------
 client/src/View/Payment/Clone.hs   |  46 ++++++-------
 client/src/View/Payment/Delete.hs  |  57 ++++++++--------
 client/src/View/Payment/Edit.hs    |  46 ++++++-------
 client/src/View/Payment/Form.hs    | 129 ++++++++++++++++++-------------------
 client/src/View/Payment/Header.hs  |  96 ++++++++++++++-------------
 client/src/View/Payment/Pages.hs   |  57 ++++++++--------
 client/src/View/Payment/Payment.hs |  75 +++++++++++----------
 client/src/View/Payment/Table.hs   | 121 +++++++++++++++++-----------------
 9 files changed, 329 insertions(+), 338 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 163a200..e983465 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -1,6 +1,6 @@
 module View.Payment.Add
   ( view
-  , Input(..)
+  , In(..)
   ) where
 
 import           Control.Monad          (join)
@@ -21,32 +21,32 @@ import qualified Util.Ajax              as Ajax
 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
+data In t = In
+  { _in_categories        :: [Category]
+  , _in_paymentCategories :: Dynamic t [PaymentCategory]
+  , _in_frequency         :: Dynamic t Frequency
   }
 
-view :: forall t m. MonadWidget t m => Input t -> Modal.Content t m SavedPayment
+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 <- _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 = CreatePaymentForm
-      , Form._input_ajax = Ajax.post
+    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)
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 2fa27f3..56a33d9 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -1,5 +1,5 @@
 module View.Payment.Clone
-  ( Input(..)
+  ( In(..)
   , view
   ) where
 
@@ -21,35 +21,35 @@ import qualified Util.Ajax              as Ajax
 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
+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 => Input t -> Modal.Content t m SavedPayment
+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 <- _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 = CreatePaymentForm
-      , Form._input_ajax = Ajax.post
+    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 <$> formOutput)
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index dc7e395..471463c 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -1,28 +1,27 @@
 module View.Payment.Delete
-  ( Input(..)
+  ( 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           Component       (ButtonIn (..), ButtonOut (..))
-import qualified Component       as Component
-import qualified Component.Modal as Modal
-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
+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 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 => (Input t) -> Modal.Content t m 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
@@ -31,20 +30,20 @@ view input _ =
 
       (confirm, cancel) <- R.divClass "buttons" $ do
 
-        cancel <- Component._buttonOut_clic <$> (Component.button $
-          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
-            { _buttonIn_class = R.constDyn "undo" })
+        cancel <- Button._out_clic <$> (Button.view $
+          (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
+            { Button._in_class = R.constDyn "undo" })
 
         rec
-          confirm <- Component._buttonOut_clic <$> (Component.button $
-            (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
-              { _buttonIn_class = R.constDyn "confirm"
-              , _buttonIn_submit = True
-              , _buttonIn_waiting = waiting
+          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 (_input_payment input) (\id ->
+                R.ffor (_in_payment input) (\id ->
                   T.concat ["/api/payment/", T.pack . show $ _payment_id id]
                 )
 
@@ -56,5 +55,5 @@ view input _ =
 
       return $
         ( R.leftmost [ cancel, () <$ confirm ]
-        , R.tag (R.current $ _input_payment input) 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
index 77841ce..5cb4537 100644
--- a/client/src/View/Payment/Edit.hs
+++ b/client/src/View/Payment/Edit.hs
@@ -1,5 +1,5 @@
 module View.Payment.Edit
-  ( Input(..)
+  ( In(..)
   , view
   ) where
 
@@ -18,33 +18,33 @@ import qualified Util.Ajax         as Ajax
 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
+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 => Input t -> Modal.Content t m SavedPayment
+view :: forall t m. MonadWidget t m => In 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 = EditPaymentForm (_payment_id payment)
-      , Form._input_ajax = Ajax.put
+    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)
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 1f068fd..29768aa 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -1,7 +1,7 @@
 module View.Payment.Form
   ( view
-  , Input(..)
-  , Output(..)
+  , In(..)
+  , Out(..)
   ) where
 
 import           Data.Aeson                (ToJSON)
@@ -25,49 +25,48 @@ import           Common.Model              (Category (..), CategoryId,
                                             SavedPayment (..))
 import qualified Common.Msg                as Msg
 import qualified Common.Validation.Payment as PaymentValidation
-import           Component                 (InputIn (..), InputOut (..),
-                                            ModalFormIn (..), ModalFormOut (..),
-                                            SelectIn (..), SelectOut (..))
-import qualified Component                 as Component
+import qualified Component.Input           as Input
+import qualified Component.ModalForm       as ModalForm
+import qualified Component.Select          as Select
 import qualified Util.Validation           as ValidationUtil
 
-data Input m t a = 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 -> Text -> Text -> CategoryId -> Frequency -> a
-  , _input_ajax              :: Text -> Event t a -> m (Event t (Either Text SavedPayment))
+data In m t a = In
+  { _in_cancel            :: Event t ()
+  , _in_headerLabel       :: Text
+  , _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))
   }
 
-data Output t = Output
+data Out t = Out
   { _output_hide       :: Event t ()
   , _output_addPayment :: Event t SavedPayment
   }
 
-view :: forall t m a. (MonadWidget t m, ToJSON a) => Input m t a -> m (Output t)
+view :: forall t m a. (MonadWidget t m, ToJSON a) => In m t a -> m (Out t)
 view input = do
   rec
     let reset = R.leftmost
-          [ "" <$ _modalFormOut_cancel modalForm
-          , "" <$ _modalFormOut_validate modalForm
-          , "" <$ _input_cancel input
+          [ "" <$ ModalForm._out_cancel modalForm
+          , "" <$ ModalForm._out_validate modalForm
+          , "" <$ _in_cancel input
           ]
 
-    modalForm <- Component.modalForm $ ModalFormIn
-      { _modalFormIn_headerLabel = _input_headerLabel input
-      , _modalFormIn_ajax        = _input_ajax input "/api/payment"
-      , _modalFormIn_form        = form reset (_modalFormOut_confirm modalForm)
+    modalForm <- ModalForm.view $ ModalForm.In
+      { ModalForm._in_headerLabel = _in_headerLabel input
+      , ModalForm._in_ajax        = _in_ajax input "/api/payment"
+      , ModalForm._in_form        = form reset (ModalForm._out_confirm modalForm)
       }
 
-  return $ Output
-    { _output_hide = _modalFormOut_hide modalForm
-    , _output_addPayment = _modalFormOut_validate modalForm
+  return $ Out
+    { _output_hide = ModalForm._out_hide modalForm
+    , _output_addPayment = ModalForm._out_validate modalForm
     }
 
   where
@@ -76,63 +75,63 @@ view input = do
       -> Event t ()
       -> m (Dynamic t (Validation (NonEmpty Text) a))
     form reset confirm = do
-      name <- Component.input
-        (Component.defaultInputIn
-          { _inputIn_label = Msg.get Msg.Payment_Name
-          , _inputIn_initialValue = _input_name input
-          , _inputIn_validation = PaymentValidation.name
+      name <- Input.view
+        (Input.defaultIn
+          { Input._in_label = Msg.get Msg.Payment_Name
+          , Input._in_initialValue = _in_name input
+          , Input._in_validation = PaymentValidation.name
           })
-        (_input_name input <$ reset)
+        (_in_name input <$ reset)
         confirm
 
-      cost <- _inputOut_raw <$> (Component.input
-        (Component.defaultInputIn
-          { _inputIn_label = Msg.get Msg.Payment_Cost
-          , _inputIn_initialValue = _input_cost input
-          , _inputIn_validation = PaymentValidation.cost
+      cost <- Input._out_raw <$> (Input.view
+        (Input.defaultIn
+          { Input._in_label = Msg.get Msg.Payment_Cost
+          , Input._in_initialValue = _in_cost input
+          , Input._in_validation = PaymentValidation.cost
           })
-        (_input_cost input <$ reset)
+        (_in_cost input <$ reset)
         confirm)
 
-      let initialDate = T.pack . Calendar.showGregorian . _input_date $ input
+      let initialDate = T.pack . Calendar.showGregorian . _in_date $ input
 
-      date <- _inputOut_raw <$> (Component.input
-        (Component.defaultInputIn
-          { _inputIn_label = Msg.get Msg.Payment_Date
-          , _inputIn_initialValue = initialDate
-          , _inputIn_inputType = "date"
-          , _inputIn_hasResetButton = False
-          , _inputIn_validation = PaymentValidation.date
+      date <- Input._out_raw <$> (Input.view
+        (Input.defaultIn
+          { Input._in_label = Msg.get Msg.Payment_Date
+          , Input._in_initialValue = initialDate
+          , Input._in_inputType = "date"
+          , Input._in_hasResetButton = False
+          , Input._in_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 = PaymentValidation.category (map _category_id $ _input_categories input)
-        , _selectIn_validate = confirm
+              R.ffor (Input._out_raw name) $ \name ->
+                findCategory name (_in_paymentCategories input)
+
+      category <- Select._out_value <$> (Select.view $ Select.In
+        { Select._in_label = Msg.get Msg.Payment_Category
+        , Select._in_initialValue = _in_category input
+        , Select._in_value = setCategory
+        , Select._in_values = R.constDyn categories
+        , Select._in_reset = _in_category input <$ reset
+        , Select._in_isValid = PaymentValidation.category (map _category_id $ _in_categories input)
+        , Select._in_validate = confirm
         })
 
       return $ do
-        n <- _inputOut_value name
+        n <- Input._out_value name
         c <- cost
         d <- date
         cat <- category
-        return ((_input_mkPayload input)
+        return ((_in_mkPayload input)
           <$> ValidationUtil.nelError n
           <*> V.Success c
           <*> V.Success d
           <*> ValidationUtil.nelError cat
-          <*> V.Success (_input_frequency input))
+          <*> V.Success (_in_frequency input))
 
     frequencies =
       M.fromList
@@ -140,7 +139,7 @@ view input = do
         , (Monthly, Msg.get Msg.Payment_MonthlyMale)
         ]
 
-    categories = M.fromList . flip map (_input_categories input) $ \c ->
+    categories = M.fromList . flip map (_in_categories input) $ \c ->
       (_category_id c, _category_name c)
 
 findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 9ad90a9..00987a3 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -1,7 +1,7 @@
 module View.Payment.Header
-  ( widget
-  , HeaderIn(..)
-  , HeaderOut(..)
+  ( view
+  , In(..)
+  , Out(..)
   ) where
 
 import           Control.Monad          (forM_)
@@ -27,31 +27,30 @@ import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.View.Format     as Format
 
-import           Component              (ButtonIn (..), ButtonOut (..),
-                                         InputIn (..), InputOut (..),
-                                         SelectIn (..), SelectOut (..))
-import qualified Component              as Component
+import qualified Component.Button       as Button
+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           View.Payment.Init      (Init (..))
 
-data HeaderIn t = HeaderIn
-  { _headerIn_init              :: Init
-  , _headerIn_currency          :: Currency
-  , _headerIn_payments          :: Dynamic t [Payment]
-  , _headerIn_searchPayments    :: Dynamic t [Payment]
-  , _headerIn_paymentCategories :: Dynamic t [PaymentCategory]
+data In t = In
+  { _in_init              :: Init
+  , _in_currency          :: Currency
+  , _in_payments          :: Dynamic t [Payment]
+  , _in_searchPayments    :: Dynamic t [Payment]
+  , _in_paymentCategories :: Dynamic t [PaymentCategory]
   }
 
-data HeaderOut t = HeaderOut
-  { _headerOut_searchName      :: Dynamic t Text
-  , _headerOut_searchFrequency :: Dynamic t Frequency
-  , _headerOut_addPayment      :: Event t SavedPayment
+data Out t = Out
+  { _out_searchName      :: Dynamic t Text
+  , _out_searchFrequency :: Dynamic t Frequency
+  , _out_addPayment      :: Event t SavedPayment
   }
 
-widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
-widget headerIn =
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input =
   R.divClass "header" $ do
     rec
       addPayment <-
@@ -66,22 +65,22 @@ widget headerIn =
       let resetSearchName = fmap (const ()) $ addPayment
       (searchName, searchFrequency)  <- searchLine resetSearchName
 
-      infos (_headerIn_searchPayments headerIn) users currency
+      infos (_in_searchPayments input) users currency
 
-    return $ HeaderOut
-      { _headerOut_searchName = searchName
-      , _headerOut_searchFrequency = searchFrequency
-      , _headerOut_addPayment = addPayment
+    return $ Out
+      { _out_searchName = searchName
+      , _out_searchFrequency = searchFrequency
+      , _out_addPayment = addPayment
       }
   where
-    init = _headerIn_init headerIn
+    init = _in_init input
     incomes = _init_incomes init
     initPayments = _init_payments init
-    payments = _headerIn_payments headerIn
+    payments = _in_payments input
     users = _init_users init
     categories = _init_categories init
-    currency = _headerIn_currency headerIn
-    paymentCategories = _headerIn_paymentCategories headerIn
+    currency = _in_currency input
+    paymentCategories = _in_paymentCategories input
 
 payerAndAdd
   :: forall t m. MonadWidget t m
@@ -113,18 +112,18 @@ payerAndAdd incomes payments users categories paymentCategories currency frequen
             R.dynText . R.ffor exceedingPayer $ \ep ->
               Format.price currency $ _exceedingPayer_amount ep
 
-    addPayment <- _buttonOut_clic <$>
-      (Component.button $
-        (Component.defaultButtonIn (R.text $ Msg.get Msg.Payment_Add))
-          { _buttonIn_class = R.constDyn "addPayment"
+    addPayment <- Button._out_clic <$>
+      (Button.view $
+        (Button.defaultIn (R.text $ Msg.get Msg.Payment_Add))
+          { Button._in_class = R.constDyn "addPayment"
           })
 
-    Modal.view $ Modal.Input
-      { Modal._input_show    = addPayment
-      , Modal._input_content = Add.view $ Add.Input
-          { Add._input_categories = categories
-          , Add._input_paymentCategories = paymentCategories
-          , Add._input_frequency = frequency
+    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
           }
       }
 
@@ -134,8 +133,8 @@ searchLine
   -> m (Dynamic t Text, Dynamic t Frequency)
 searchLine reset = do
   R.divClass "searchLine" $ do
-    searchName <- _inputOut_raw <$> (Component.input
-      ( Component.defaultInputIn { _inputIn_label = Msg.get Msg.Search_Name })
+    searchName <- Input._out_raw <$> (Input.view
+      ( Input.defaultIn { Input._in_label = Msg.get Msg.Search_Name })
       ("" <$ reset)
       R.never)
 
@@ -144,15 +143,14 @@ searchLine reset = do
           , (Monthly, Msg.get Msg.Payment_MonthlyMale)
           ]
 
-    searchFrequency <- _selectOut_raw <$> (Component.select $
-      SelectIn
-        { _selectIn_label        = ""
-        , _selectIn_initialValue = Punctual
-        , _selectIn_value        = R.never
-        , _selectIn_values       = R.constDyn frequencies
-        , _selectIn_reset        = R.never
-        , _selectIn_isValid      = V.Success
-        , _selectIn_validate     = R.never
+    searchFrequency <- Select._out_raw <$> (Select.view $ Select.In
+        { Select._in_label        = ""
+        , Select._in_initialValue = Punctual
+        , Select._in_value        = R.never
+        , Select._in_values       = R.constDyn frequencies
+        , Select._in_reset        = R.never
+        , Select._in_isValid      = V.Success
+        , Select._in_validate     = R.never
         })
 
     return (searchName, searchFrequency)
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 5681935..9a1902c 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -1,41 +1,40 @@
 module View.Payment.Pages
-  ( widget
-  , PagesIn(..)
-  , PagesOut(..)
+  ( view
+  , In(..)
+  , Out(..)
   ) 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 qualified Component.Button as Button
 
-import qualified Util.Reflex as ReflexUtil
-import qualified View.Icon   as Icon
+import qualified Util.Reflex      as ReflexUtil
+import qualified View.Icon        as Icon
 
-data PagesIn t = PagesIn
-  { _pagesIn_total   :: Dynamic t Int
-  , _pagesIn_perPage :: Int
-  , _pagesIn_reset   :: Event t ()
+data In t = In
+  { _in_total   :: Dynamic t Int
+  , _in_perPage :: Int
+  , _in_reset   :: Event t ()
   }
 
-data PagesOut t = PagesOut
-  { _pagesOut_currentPage :: Dynamic t Int
+data Out t = Out
+  { _out_currentPage :: Dynamic t Int
   }
 
-widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
-widget pagesIn = do
+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 $ PagesOut
-    { _pagesOut_currentPage = currentPage
+  return $ Out
+    { _out_currentPage = currentPage
     }
 
   where
-    total = _pagesIn_total pagesIn
-    perPage = _pagesIn_perPage pagesIn
-    reset = _pagesIn_reset pagesIn
+    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
@@ -75,14 +74,14 @@ range currentPage maxPage = [start..end]
 
 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 <- _buttonOut_clic <$> (Component.button $ ButtonIn
-    { _buttonIn_class   = 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"
-    , _buttonIn_content = content
-    , _buttonIn_waiting = R.never
-    , _buttonIn_tabIndex = Nothing
-    , _buttonIn_submit = False
+    , 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 5f0d03c..f86acd8 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -1,7 +1,7 @@
 module View.Payment.Payment
   ( init
   , view
-  , PaymentIn(..)
+  , In(..)
   ) where
 
 import           Data.Text           (Text)
@@ -20,12 +20,9 @@ import qualified Common.Util.Text    as T
 import           Loadable            (Loadable (..))
 import qualified Loadable
 import qualified Util.Ajax           as AjaxUtil
-import           View.Payment.Header (HeaderIn (..), HeaderOut (..))
 import qualified View.Payment.Header as Header
 import           View.Payment.Init   (Init (..))
-import           View.Payment.Pages  (PagesIn (..), PagesOut (..))
 import qualified View.Payment.Pages  as Pages
-import           View.Payment.Table  (TableIn (..), TableOut (..))
 import qualified View.Payment.Table  as Table
 
 init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init))
@@ -44,21 +41,21 @@ init = do
     return $ Init <$> us <*> ps <*> is <*> cs <*> pcs
 
 
-data PaymentIn t = PaymentIn
-  { _paymentIn_currentUser :: UserId
-  , _paymentIn_currency    :: Currency
-  , _paymentIn_init        :: Dynamic t (Loadable Init)
+data In t = In
+  { _in_currentUser :: UserId
+  , _in_currency    :: Currency
+  , _in_init        :: Dynamic t (Loadable Init)
   }
 
-view :: forall t m. MonadWidget t m => PaymentIn t -> m ()
-view paymentIn = do
-  R.dyn . R.ffor (_paymentIn_init paymentIn) . Loadable.view $ \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
-              [ _headerOut_addPayment header
-              , _tableOut_addPayment table
+              [ Header._out_addPayment header
+              , Table._out_addPayment table
               ]
 
             paymentsPerPage = 7
@@ -66,46 +63,46 @@ view paymentIn = do
         payments <- reducePayments
           (_init_payments init)
           (_savedPayment_payment <$> addPayment)
-          (_savedPayment_payment <$> _tableOut_editPayment table)
-          (_tableOut_deletePayment table)
+          (_savedPayment_payment <$> Table._out_editPayment table)
+          (Table._out_deletePayment table)
 
         paymentCategories <- reducePaymentCategories
           (_init_paymentCategories init)
           payments
           (_savedPayment_paymentCategory <$> addPayment)
-          (_savedPayment_paymentCategory <$> _tableOut_editPayment table)
-          (_tableOut_deletePayment table)
+          (_savedPayment_paymentCategory <$> Table._out_editPayment table)
+          (Table._out_deletePayment table)
 
         (searchNameEvent, searchName) <-
-          debounceSearchName (_headerOut_searchName header)
+          debounceSearchName (Header._out_searchName header)
 
         let searchPayments =
-              getSearchPayments searchName (_headerOut_searchFrequency header) payments
-
-        header <- Header.widget $ HeaderIn
-          { _headerIn_init = init
-          , _headerIn_currency = _paymentIn_currency paymentIn
-          , _headerIn_payments = payments
-          , _headerIn_searchPayments = searchPayments
-          , _headerIn_paymentCategories = paymentCategories
+              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.widget $ TableIn
-          { _tableIn_init = init
-          , _tableIn_currency = _paymentIn_currency paymentIn
-          , _tableIn_currentUser = _paymentIn_currentUser paymentIn
-          , _tableIn_currentPage = _pagesOut_currentPage pages
-          , _tableIn_payments = searchPayments
-          , _tableIn_perPage = paymentsPerPage
-          , _tableIn_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.widget $ PagesIn
-          { _pagesIn_total = length <$> searchPayments
-          , _pagesIn_perPage = paymentsPerPage
-          , _pagesIn_reset = R.leftmost $
+        pages <- Pages.view $ Pages.In
+          { Pages._in_total = length <$> searchPayments
+          , Pages._in_perPage = paymentsPerPage
+          , Pages._in_reset = R.leftmost $
               [ () <$ searchNameEvent
-              , () <$ _headerOut_addPayment header
+              , () <$ Header._out_addPayment header
               ]
           }
 
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 3a0a4bf..0793836 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -1,7 +1,7 @@
 module View.Payment.Table
-  ( widget
-  , TableIn(..)
-  , TableOut(..)
+  ( view
+  , In(..)
+  , Out(..)
   ) where
 
 import qualified Data.List           as L
@@ -20,8 +20,7 @@ import           Common.Model        (Category (..), Currency,
 import qualified Common.Model        as CM
 import qualified Common.Msg          as Msg
 import qualified Common.View.Format  as Format
-import           Component           (ButtonIn (..), ButtonOut (..))
-import qualified Component           as Component
+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
@@ -31,25 +30,25 @@ import           View.Payment.Init   (Init (..))
 import qualified Util.Reflex         as ReflexUtil
 import qualified View.Icon           as Icon
 
-data TableIn t = TableIn
-  { _tableIn_init              :: Init
-  , _tableIn_currency          :: Currency
-  , _tableIn_currentUser       :: UserId
-  , _tableIn_currentPage       :: Dynamic t Int
-  , _tableIn_payments          :: Dynamic t [Payment]
-  , _tableIn_perPage           :: Int
-  , _tableIn_paymentCategories :: Dynamic t [PaymentCategory]
-  , _tableIn_categories        :: [Category]
+data In t = In
+  { _in_init              :: Init
+  , _in_currency          :: Currency
+  , _in_currentUser       :: UserId
+  , _in_currentPage       :: Dynamic t Int
+  , _in_payments          :: Dynamic t [Payment]
+  , _in_perPage           :: Int
+  , _in_paymentCategories :: Dynamic t [PaymentCategory]
+  , _in_categories        :: [Category]
   }
 
-data TableOut t = TableOut
-  { _tableOut_addPayment    :: Event t SavedPayment
-  , _tableOut_editPayment   :: Event t SavedPayment
-  , _tableOut_deletePayment :: Event t Payment
+data Out t = Out
+  { _out_addPayment    :: Event t SavedPayment
+  , _out_editPayment   :: Event t SavedPayment
+  , _out_deletePayment :: Event t Payment
   }
 
-widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
-widget tableIn = do
+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
@@ -75,20 +74,20 @@ widget tableIn = do
     ReflexUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
       R.text $ Msg.get Msg.Payment_Empty
 
-    return $ TableOut
-      { _tableOut_addPayment = addPayment
-      , _tableOut_editPayment = editPayment
-      , _tableOut_deletePayment = deletePayment
+    return $ Out
+      { _out_addPayment = addPayment
+      , _out_editPayment = editPayment
+      , _out_deletePayment = deletePayment
       }
 
   where
-    init = _tableIn_init tableIn
-    currency = _tableIn_currency tableIn
-    currentUser = _tableIn_currentUser tableIn
-    currentPage = _tableIn_currentPage tableIn
-    payments = _tableIn_payments tableIn
-    paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage
-    paymentCategories = _tableIn_paymentCategories tableIn
+    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 =
@@ -150,19 +149,19 @@ paymentRow init currency currentUser paymentCategories payment =
 
     clonePayment <-
       R.divClass "cell button" $
-        _buttonOut_clic <$> (Component.button $
-          Component.defaultButtonIn Icon.clone)
+        Button._out_clic <$> (Button.view $
+          Button.defaultIn 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
+      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
               }
         }
 
@@ -174,36 +173,36 @@ paymentRow init currency currentUser paymentCategories payment =
     editPayment <-
       R.divClass "cell button" $
         ReflexUtil.divVisibleIf isFromCurrentUser $
-          _buttonOut_clic <$> (Component.button $
-            Component.defaultButtonIn Icon.edit)
+          Button._out_clic <$> (Button.view $
+            Button.defaultIn 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
+      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
               }
         }
 
     deletePayment <-
       R.divClass "cell button" $
         ReflexUtil.divVisibleIf isFromCurrentUser $
-          _buttonOut_clic <$> (Component.button $
-            (Component.defaultButtonIn Icon.delete)
-              { _buttonIn_class = R.constDyn "deletePayment"
+          Button._out_clic <$> (Button.view $
+            (Button.defaultIn Icon.delete)
+              { Button._in_class = R.constDyn "deletePayment"
               })
 
     paymentDeleted <-
-      Modal.view $ Modal.Input
-        { Modal._input_show    = deletePayment
-        , Modal._input_content =
-            Delete.view $ Delete.Input
-              { Delete._input_payment = payment
+      Modal.view $ Modal.In
+        { Modal._in_show    = deletePayment
+        , Modal._in_content =
+            Delete.view $ Delete.In
+              { Delete._in_payment = payment
               }
         }
 
-- 
cgit v1.2.3


From 61ff1443c42def5a09f624e3df2e2520e97610d0 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 22 Oct 2019 23:25:05 +0200
Subject: Clone incomes

---
 client/src/View/Payment/Clone.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 56a33d9..82b0c27 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -34,7 +34,7 @@ view input cancel = do
 
   currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
 
-  formOutput <- R.dyn $ do
+  form <- R.dyn $ do
     paymentCategories <- _in_paymentCategories input
     payment <- _in_payment input
     category <- _in_category input
@@ -52,8 +52,8 @@ view input cancel = do
       , Form._in_ajax = Ajax.post
       }
 
-  hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
-  clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> formOutput)
+  hide <- ReflexUtil.flatten (Form._output_hide <$> form)
+  clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> form)
 
   return $
     ( hide
-- 
cgit v1.2.3


From f968c8ce63e1aec119b1e6f414cf27e2c0294bcb Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 23 Oct 2019 21:09:54 +0200
Subject: Delete income

---
 client/src/View/Payment/Delete.hs | 1 -
 1 file changed, 1 deletion(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 471463c..e5e7219 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -12,7 +12,6 @@ import           Common.Model     (Payment (..))
 import qualified Common.Msg       as Msg
 import qualified Component.Button as Button
 import qualified Component.Modal  as Modal
-import qualified Component.Modal  as Modal
 import qualified Util.Ajax        as Ajax
 import qualified Util.Either      as EitherUtil
 import qualified Util.WaitFor     as WaitFor
-- 
cgit v1.2.3


From 182f3d3fea9985c0e403087fe253981c68e57102 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 3 Nov 2019 11:33:20 +0100
Subject: Fix payment page

---
 client/src/View/Payment/Payment.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index f86acd8..e72577f 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -29,7 +29,7 @@ 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/incomes"
+  incomes <- AjaxUtil.getNow "api/deprecated/incomes"
   categories <- AjaxUtil.getNow "api/categories"
   paymentCategories <- AjaxUtil.getNow "api/paymentCategories"
   return $ do
-- 
cgit v1.2.3


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/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 +++++++++++++------------------
 10 files changed, 489 insertions(+), 721 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/src/View/Payment')

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


From 4dc84dbda7ba3ea60d13e6f81eeec556974b7c72 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 7 Nov 2019 07:59:41 +0100
Subject: Show payment header infos

---
 client/src/View/Payment/Header.hs      | 187 ---------------------------------
 client/src/View/Payment/HeaderForm.hs  |  78 ++++++++++++++
 client/src/View/Payment/HeaderInfos.hs |  96 +++++++++++++++++
 client/src/View/Payment/Init.hs        |  13 ---
 client/src/View/Payment/Payment.hs     |  53 ++++++----
 5 files changed, 204 insertions(+), 223 deletions(-)
 delete mode 100644 client/src/View/Payment/Header.hs
 create mode 100644 client/src/View/Payment/HeaderForm.hs
 create mode 100644 client/src/View/Payment/HeaderInfos.hs
 delete mode 100644 client/src/View/Payment/Init.hs

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
deleted file mode 100644
index c8ca347..0000000
--- a/client/src/View/Payment/Header.hs
+++ /dev/null
@@ -1,187 +0,0 @@
-module View.Payment.Header
-  ( view
-  , In(..)
-  , Out(..)
-  ) where
-
-import           Control.Monad          (forM_)
-import           Control.Monad.IO.Class (liftIO)
-import qualified Data.List              as L hiding (groupBy)
-import qualified Data.Map               as M
-import           Data.Maybe             (fromMaybe)
-import           Data.Text              (Text)
-import qualified Data.Text              as T
-import           Data.Time              (NominalDiffTime)
-import qualified Data.Time              as Time
-import qualified Data.Validation        as V
-import           Prelude                hiding (init)
-import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex)
-import qualified Reflex.Dom             as R
-
-import           Common.Model           (Category, Currency,
-                                         ExceedingPayer (..), Frequency (..),
-                                         Income (..), Payment (..),
-                                         PaymentCategory, SavedPayment (..),
-                                         User (..))
-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.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.Form      as Form
-import           View.Payment.Init      (Init (..))
-
-data In t = In
-  { _in_init              :: Init
-  , _in_currency          :: Currency
-  , _in_payments          :: Dynamic t [Payment]
-  , _in_searchPayments    :: Dynamic t [Payment]
-  , _in_paymentCategories :: Dynamic t [PaymentCategory]
-  }
-
-data Out t = Out
-  { _out_searchName      :: Dynamic t Text
-  , _out_searchFrequency :: Dynamic t Frequency
-  , _out_addPayment      :: Event t SavedPayment
-  }
-
-view :: forall t m. MonadWidget t m => In t -> m (Out t)
-view input =
-  R.divClass "header" $ do
-    rec
-      addPayment <-
-        payerAndAdd
-          incomes
-          payments
-          users
-          categories
-          paymentCategories
-          currency
-          searchFrequency
-      let resetSearchName = fmap (const ()) $ addPayment
-      (searchName, searchFrequency)  <- searchLine resetSearchName
-
-      infos (_in_searchPayments input) users currency
-
-    return $ Out
-      { _out_searchName = searchName
-      , _out_searchFrequency = searchFrequency
-      , _out_addPayment = addPayment
-      }
-  where
-    init = _in_init input
-    incomes = _init_incomes init
-    initPayments = _init_payments init
-    payments = _in_payments input
-    users = _init_users init
-    categories = _init_categories init
-    currency = _in_currency input
-    paymentCategories = _in_paymentCategories input
-
-payerAndAdd
-  :: forall t m. MonadWidget t m
-  => [Income]
-  -> Dynamic t [Payment]
-  -> [User]
-  -> [Category]
-  -> Dynamic t [PaymentCategory]
-  -> Currency
-  -> Dynamic t Frequency
-  -> m (Event t SavedPayment)
-payerAndAdd incomes payments users categories paymentCategories currency frequency = do
-  time <- liftIO Time.getCurrentTime
-  R.divClass "payerAndAdd" $ do
-
-    let exceedingPayers =
-          R.ffor payments $ \ps ->
-            CM.getExceedingPayers time users incomes $
-              filter ((==) Punctual . _payment_frequency) ps
-
-    R.divClass "exceedingPayers" $
-      R.simpleList exceedingPayers $ \exceedingPayer ->
-        R.elClass "span" "exceedingPayer" $ do
-          R.elClass "span" "userName" $
-            R.dynText . R.ffor exceedingPayer $ \ep ->
-              fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId ep) users
-          R.elClass "span" "amount" $ do
-            R.text "+ "
-            R.dynText . R.ffor exceedingPayer $ \ep ->
-              Format.price currency $ _exceedingPayer_amount ep
-
-    addPayment <- Button._out_clic <$>
-      (Button.view $
-        (Button.defaultIn (R.text $ Msg.get Msg.Payment_Add))
-          { Button._in_class = R.constDyn "addPayment"
-          })
-
-    Modal.view $ Modal.In
-      { Modal._in_show    = addPayment
-      , Modal._in_content = \_ -> return (R.never, R.never) -- TODO
-      }
-
-searchLine
-  :: forall t m. MonadWidget t m
-  => Event t ()
-  -> m (Dynamic t Text, Dynamic t Frequency)
-searchLine reset = do
-  R.divClass "searchLine" $ do
-    searchName <- Input._out_raw <$> (Input.view
-      ( Input.defaultIn { Input._in_label = Msg.get Msg.Search_Name })
-      ("" <$ reset)
-      R.never)
-
-    let frequencies = M.fromList
-          [ (Punctual, Msg.get Msg.Payment_PunctualMale)
-          , (Monthly, Msg.get Msg.Payment_MonthlyMale)
-          ]
-
-    searchFrequency <- Select._out_raw <$> (Select.view $ Select.In
-        { Select._in_label        = ""
-        , Select._in_initialValue = Punctual
-        , Select._in_value        = R.never
-        , Select._in_values       = R.constDyn frequencies
-        , Select._in_reset        = R.never
-        , Select._in_isValid      = V.Success
-        , Select._in_validate     = R.never
-        })
-
-    return (searchName, searchFrequency)
-
-infos
-  :: forall t m. MonadWidget t m
-  => Dynamic t [Payment]
-  -> [User]
-  -> Currency -> m ()
-infos payments users currency =
-  R.divClass "infos" $ do
-
-    R.elClass "span" "total" $ do
-      R.dynText $ do
-        ps <- payments
-        let paymentCount = length ps
-            total = sum . map _payment_cost $ ps
-        pure . Msg.get $ Msg.Payment_Worth
-          (T.intercalate " "
-            [ (Format.number paymentCount)
-            , if paymentCount > 1
-                then Msg.get Msg.Payment_Many
-                else Msg.get Msg.Payment_One
-            ])
-          (Format.price currency total)
-
-    R.elClass "span" "partition" . R.dynText $ do
-      ps <- payments
-      let totalByUser =
-            L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
-              . map (\(u, xs) -> (u, sum . map snd $ xs))
-              . L.groupBy fst
-              . map (\p -> (_payment_user p, _payment_cost p))
-              $ ps
-      pure . T.intercalate ", " . flip map totalByUser $ \(userId, userTotal) ->
-        Msg.get $ Msg.Payment_By
-          (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
-          (Format.price currency userTotal)
diff --git a/client/src/View/Payment/HeaderForm.hs b/client/src/View/Payment/HeaderForm.hs
new file mode 100644
index 0000000..07a6b81
--- /dev/null
+++ b/client/src/View/Payment/HeaderForm.hs
@@ -0,0 +1,78 @@
+module View.Payment.HeaderForm
+  ( view
+  ) where
+
+import qualified Data.Map          as M
+import           Data.Text         (Text)
+import qualified Data.Validation   as V
+import           Reflex.Dom        (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom        as R
+
+import           Common.Model      (Category, Currency, ExceedingPayer (..),
+                                    Frequency (..), Income (..), Payment (..),
+                                    PaymentCategory, SavedPayment (..),
+                                    User (..))
+import qualified Common.Msg        as Msg
+
+import qualified Component.Button  as Button
+import qualified Component.Input   as Input
+import qualified Component.Modal   as Modal
+import qualified Component.Select  as Select
+import qualified View.Payment.Form as Form
+
+data In t = In
+  { _in_reset             :: Event t ()
+  , _in_categories        :: [Category]
+  , _in_paymentCategories :: [PaymentCategory]
+  }
+
+data Out = Out
+  { _out_name       :: Event t Text
+  , _out_frequency  :: Event t Frequency
+  , _out_addPayment :: Event t SavedPayment
+  }
+
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input = do
+  R.divClass "g-HeaderForm" $ do
+    searchName <- Input._out_raw <$> (Input.view
+      ( Input.defaultIn { Input._in_label = Msg.get Msg.Search_Name })
+      ("" <$ _in_reset input)
+      R.never)
+
+    let frequencies = M.fromList
+          [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+          , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+          ]
+
+    searchFrequency <- Select._out_raw <$> (Select.view $ Select.In
+        { Select._in_label        = ""
+        , Select._in_initialValue = Punctual
+        , Select._in_value        = R.never
+        , Select._in_values       = R.constDyn frequencies
+        , Select._in_reset        = R.never
+        , Select._in_isValid      = V.Success
+        , Select._in_validate     = R.never
+        })
+
+    addPaymentButton <- Button._out_clic <$>
+      (Button.view $
+        (Button.defaultIn (R.text $ Msg.get Msg.Payment_Add))
+          { Button._in_class = R.constDyn "addPayment"
+          })
+
+    addPayment <- Modal.view $ Modal.In
+      { Modal._in_show    = addPaymentButton
+      , Modal._in_content =
+        Form.view $ Form.In
+          { Form._in_categories = _in_categories input
+          , Form._in_paymentCategories = _in_paymentCategories input
+          , Form._in_operation = Form.New searchFrequency
+          }
+      }
+
+    return $ Out
+      { _out_name = searchName
+      , _out_frequency = searchFrequency
+      , _out_addPayment = addPayment
+      }
diff --git a/client/src/View/Payment/HeaderInfos.hs b/client/src/View/Payment/HeaderInfos.hs
new file mode 100644
index 0000000..12facc4
--- /dev/null
+++ b/client/src/View/Payment/HeaderInfos.hs
@@ -0,0 +1,96 @@
+module View.Payment.HeaderInfos
+  ( view
+  , In(..)
+  ) where
+
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.List              as L hiding (groupBy)
+import           Data.Map               (Map)
+import qualified Data.Map               as M
+import           Data.Maybe             (fromMaybe)
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import qualified Data.Time              as Time
+import           Reflex.Dom             (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom             as R
+
+import           Common.Model           (Currency, ExceedingPayer (..),
+                                         Payment (..), PaymentHeader (..),
+                                         SavedPayment (..), User (..), UserId)
+import qualified Common.Model           as CM
+import qualified Common.Msg             as Msg
+import qualified Common.View.Format     as Format
+
+import qualified Util.List              as L
+
+data In t = In
+  { _in_users        :: [User]
+  , _in_currency     :: Currency
+  , _in_header       :: PaymentHeader
+  , _in_paymentCount :: Int
+  }
+
+view :: forall t m. MonadWidget t m => In t -> m ()
+view input =
+  R.divClass "g-HeaderInfos" $ do
+      exceedingPayers
+        (_in_users input)
+        (_in_currency input)
+        (_paymentHeader_exceedingPayers header)
+
+      infos
+        (_in_users input)
+        (_in_currency input)
+        (_paymentHeader_repartition header)
+        (_in_paymentCount input)
+
+  where
+    header = _in_header input
+
+exceedingPayers
+  :: forall t m. MonadWidget t m
+  => [User]
+  -> Currency
+  -> [ExceedingPayer]
+  -> m ()
+exceedingPayers users currency payers =
+  R.divClass "g-HeaderInfos__ExceedingPayers" $
+    flip mapM_ payers $ \payer ->
+      R.elClass "span" "exceedingPayer" $ do
+        R.elClass "span" "userName" $
+          R.text $
+            fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId payer) users
+        R.elClass "span" "amount" $ do
+          R.text "+ "
+          R.text . Format.price currency $ _exceedingPayer_amount payer
+
+infos
+  :: forall t m. MonadWidget t m
+  => [User]
+  -> Currency
+  -> Map UserId Int
+  -> Int
+  -> m ()
+infos users currency repartition paymentCount =
+  R.divClass "g-HeaderInfos__Repartition" $ do
+
+    R.elClass "span" "total" $ do
+      R.text $
+        Msg.get $ Msg.Payment_Worth
+          (T.intercalate " "
+            [ (Format.number paymentCount)
+            , if paymentCount > 1
+                then Msg.get Msg.Payment_Many
+                else Msg.get Msg.Payment_One
+            ])
+          (Format.price currency (M.foldl (+) 0 repartition))
+
+    R.elClass "span" "partition" . R.text $
+      let totalByUser =
+            L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
+              . M.toList
+              $ repartition
+      in  T.intercalate ", " . flip map totalByUser $ \(userId, userTotal) ->
+            Msg.get $ Msg.Payment_By
+              (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
+              (Format.price currency userTotal)
diff --git a/client/src/View/Payment/Init.hs b/client/src/View/Payment/Init.hs
deleted file mode 100644
index d9f85c8..0000000
--- a/client/src/View/Payment/Init.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module View.Payment.Init
-  ( Init(..)
-  ) where
-
-import           Common.Model (Category, Income, Payment, PaymentCategory, User)
-
-data Init = Init
-  { _init_users             :: [User]
-  , _init_payments          :: [Payment]
-  , _init_incomes           :: [Income]
-  , _init_categories        :: [Category]
-  , _init_paymentCategories :: [PaymentCategory]
-  } deriving (Show)
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index bf0186f..f47b627 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -3,29 +3,29 @@ module View.Payment.Payment
   , In(..)
   ) where
 
-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 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 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
+import qualified Util.Ajax                as AjaxUtil
+import qualified Util.Reflex              as ReflexUtil
+import qualified View.Payment.HeaderInfos as HeaderInfos
+-- import qualified View.Payment.HeaderForm as HeaderForm
+import qualified View.Payment.Reducer     as Reducer
+import qualified View.Payment.Table       as Table
 
 data In t = In
   { _in_currentUser :: UserId
@@ -61,7 +61,14 @@ view input = do
       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
+        flip Loadable.view is $ \(PaymentPage header payments paymentCategories count) -> do
+          HeaderInfos.view $ HeaderInfos.In
+            { HeaderInfos._in_users = _in_users input
+            , HeaderInfos._in_currency = _in_currency input
+            , HeaderInfos._in_header = header
+            , HeaderInfos._in_paymentCount = count
+            }
+
           table <- Table.view $ Table.In
             { Table._in_users = _in_users input
             , Table._in_currentUser = _in_currentUser input
-- 
cgit v1.2.3


From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 17 Nov 2019 18:08:28 +0100
Subject: Optimize and refactor payments

---
 client/src/View/Payment/Form.hs        |  52 +++++-----
 client/src/View/Payment/HeaderForm.hs  |  69 +++++++------
 client/src/View/Payment/HeaderInfos.hs |  28 +++---
 client/src/View/Payment/Payment.hs     | 177 +++++----------------------------
 client/src/View/Payment/Reducer.hs     |  83 +++++++++++++---
 client/src/View/Payment/Table.hs       |  31 ++----
 6 files changed, 176 insertions(+), 264 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 99b0848..6c3c1e8 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -4,6 +4,7 @@ module View.Payment.Form
   , Operation(..)
   ) where
 
+import           Control.Monad             (join)
 import           Control.Monad.IO.Class    (liftIO)
 import           Data.Aeson                (Value)
 import qualified Data.Aeson                as Aeson
@@ -13,6 +14,7 @@ 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                 (NominalDiffTime)
 import           Data.Time.Calendar        (Day)
 import qualified Data.Time.Calendar        as Calendar
 import qualified Data.Time.Clock           as Clock
@@ -25,9 +27,7 @@ import qualified Text.Read                 as T
 import           Common.Model              (Category (..), CategoryId,
                                             CreatePaymentForm (..),
                                             EditPaymentForm (..),
-                                            Frequency (..), Payment (..),
-                                            PaymentCategory (..),
-                                            SavedPayment (..))
+                                            Frequency (..), Payment (..))
 import qualified Common.Msg                as Msg
 import qualified Common.Util.Time          as TimeUtil
 import qualified Common.Validation.Payment as PaymentValidation
@@ -37,20 +37,20 @@ 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.Either               as EitherUtil
 import qualified Util.Validation           as ValidationUtil
 
-data In = In
-  { _in_categories        :: [Category]
-  , _in_paymentCategories :: [PaymentCategory]
-  , _in_operation         :: Operation
+data In t = In
+  { _in_categories :: [Category]
+  , _in_operation  :: Operation t
   }
 
-data Operation
-  = New Frequency
+data Operation t
+  = New (Dynamic t Frequency)
   | Clone Payment
   | Edit Payment
 
-view :: forall t m a. MonadWidget t m => In -> Modal.Content t m SavedPayment
+view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m Payment
 view input cancel = do
   rec
     let reset = R.leftmost
@@ -105,9 +105,10 @@ view input cancel = do
         (d <$ reset)
         confirm)
 
-      let setCategory =
-            R.fmapMaybe id . R.updated $
-              R.ffor (Input._out_raw name) findCategory
+      setCategory <-
+        R.debounce  (1 :: NominalDiffTime) (R.updated $ Input._out_raw name)
+          >>= (Ajax.get . (fmap ("/api/payment/category?name=" <>)))
+          >>= (return . R.mapMaybe (join . EitherUtil.eitherToMaybe))
 
       category <- Select._out_value <$> (Select.view $ Select.In
         { Select._in_label = Msg.get Msg.Payment_Category
@@ -124,12 +125,13 @@ view input cancel = do
         c <- cost
         d <- date
         cat <- category
+        f <- frequency
         return (mkPayload
           <$> ValidationUtil.nelError n
           <*> V.Success c
           <*> V.Success d
           <*> ValidationUtil.nelError cat
-          <*> V.Success frequency)
+          <*> V.Success f)
 
     frequencies =
       M.fromList
@@ -140,6 +142,12 @@ view input cancel = do
     categories = M.fromList . flip map (_in_categories input) $ \c ->
       (_category_id c, _category_name c)
 
+    category =
+      case op of
+        New _   -> -1
+        Clone p -> _payment_category p
+        Edit p  -> _payment_category p
+
     op = _in_operation input
 
     name =
@@ -162,17 +170,11 @@ view input cancel = do
           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
+        Clone p -> R.constDyn $ _payment_frequency p
+        Edit p  -> R.constDyn $ _payment_frequency p
 
     headerLabel =
       case op of
@@ -189,9 +191,3 @@ view input cancel = do
       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/HeaderForm.hs b/client/src/View/Payment/HeaderForm.hs
index 07a6b81..c8ca4d9 100644
--- a/client/src/View/Payment/HeaderForm.hs
+++ b/client/src/View/Payment/HeaderForm.hs
@@ -1,5 +1,7 @@
 module View.Payment.HeaderForm
   ( view
+  , In(..)
+  , Out(..)
   ) where
 
 import qualified Data.Map          as M
@@ -8,10 +10,8 @@ import qualified Data.Validation   as V
 import           Reflex.Dom        (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom        as R
 
-import           Common.Model      (Category, Currency, ExceedingPayer (..),
-                                    Frequency (..), Income (..), Payment (..),
-                                    PaymentCategory, SavedPayment (..),
-                                    User (..))
+import           Common.Model      (Category, Currency, Frequency (..),
+                                    Income (..), Payment (..), User (..))
 import qualified Common.Msg        as Msg
 
 import qualified Component.Button  as Button
@@ -21,39 +21,43 @@ import qualified Component.Select  as Select
 import qualified View.Payment.Form as Form
 
 data In t = In
-  { _in_reset             :: Event t ()
-  , _in_categories        :: [Category]
-  , _in_paymentCategories :: [PaymentCategory]
+  { _in_reset      :: Event t ()
+  , _in_categories :: [Category]
   }
 
-data Out = Out
-  { _out_name       :: Event t Text
+data Out t = Out
+  { _out_search     :: Event t Text
   , _out_frequency  :: Event t Frequency
-  , _out_addPayment :: Event t SavedPayment
+  , _out_addPayment :: Event t Payment
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
-view input = do
-  R.divClass "g-HeaderForm" $ do
-    searchName <- Input._out_raw <$> (Input.view
-      ( Input.defaultIn { Input._in_label = Msg.get Msg.Search_Name })
-      ("" <$ _in_reset input)
-      R.never)
+view input =
+  R.divClass "g-PaymentHeaderForm" $ do
 
-    let frequencies = M.fromList
-          [ (Punctual, Msg.get Msg.Payment_PunctualMale)
-          , (Monthly, Msg.get Msg.Payment_MonthlyMale)
-          ]
+    (searchName, frequency) <- R.el "div" $ do
 
-    searchFrequency <- Select._out_raw <$> (Select.view $ Select.In
-        { Select._in_label        = ""
-        , Select._in_initialValue = Punctual
-        , Select._in_value        = R.never
-        , Select._in_values       = R.constDyn frequencies
-        , Select._in_reset        = R.never
-        , Select._in_isValid      = V.Success
-        , Select._in_validate     = R.never
-        })
+      searchName <- Input._out_raw <$> (Input.view
+        ( Input.defaultIn { Input._in_label = Msg.get Msg.Search_Name })
+        ("" <$ _in_reset input)
+        R.never)
+
+      let frequencies = M.fromList
+            [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+            , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+            ]
+
+      frequency <- Select._out_raw <$> (Select.view $ Select.In
+          { Select._in_label        = ""
+          , Select._in_initialValue = Punctual
+          , Select._in_value        = R.never
+          , Select._in_values       = R.constDyn frequencies
+          , Select._in_reset        = R.never
+          , Select._in_isValid      = V.Success
+          , Select._in_validate     = R.never
+          })
+
+      return (searchName, frequency)
 
     addPaymentButton <- Button._out_clic <$>
       (Button.view $
@@ -66,13 +70,12 @@ view input = do
       , Modal._in_content =
         Form.view $ Form.In
           { Form._in_categories = _in_categories input
-          , Form._in_paymentCategories = _in_paymentCategories input
-          , Form._in_operation = Form.New searchFrequency
+          , Form._in_operation = Form.New frequency
           }
       }
 
     return $ Out
-      { _out_name = searchName
-      , _out_frequency = searchFrequency
+      { _out_search = R.updated searchName
+      , _out_frequency = R.updated frequency
       , _out_addPayment = addPayment
       }
diff --git a/client/src/View/Payment/HeaderInfos.hs b/client/src/View/Payment/HeaderInfos.hs
index 12facc4..f84ee1f 100644
--- a/client/src/View/Payment/HeaderInfos.hs
+++ b/client/src/View/Payment/HeaderInfos.hs
@@ -16,13 +16,11 @@ import qualified Reflex.Dom             as R
 
 import           Common.Model           (Currency, ExceedingPayer (..),
                                          Payment (..), PaymentHeader (..),
-                                         SavedPayment (..), User (..), UserId)
+                                         User (..), UserId)
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.View.Format     as Format
 
-import qualified Util.List              as L
-
 data In t = In
   { _in_users        :: [User]
   , _in_currency     :: Currency
@@ -32,17 +30,17 @@ data In t = In
 
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input =
-  R.divClass "g-HeaderInfos" $ do
-      exceedingPayers
-        (_in_users input)
-        (_in_currency input)
-        (_paymentHeader_exceedingPayers header)
+  R.divClass "g-PaymentHeaderInfos" $ do
+    exceedingPayers
+      (_in_users input)
+      (_in_currency input)
+      (_paymentHeader_exceedingPayers header)
 
-      infos
-        (_in_users input)
-        (_in_currency input)
-        (_paymentHeader_repartition header)
-        (_in_paymentCount input)
+    infos
+      (_in_users input)
+      (_in_currency input)
+      (_paymentHeader_repartition header)
+      (_in_paymentCount input)
 
   where
     header = _in_header input
@@ -54,7 +52,7 @@ exceedingPayers
   -> [ExceedingPayer]
   -> m ()
 exceedingPayers users currency payers =
-  R.divClass "g-HeaderInfos__ExceedingPayers" $
+  R.divClass "g-PaymentHeaderInfos__ExceedingPayers" $
     flip mapM_ payers $ \payer ->
       R.elClass "span" "exceedingPayer" $ do
         R.elClass "span" "userName" $
@@ -72,7 +70,7 @@ infos
   -> Int
   -> m ()
 infos users currency repartition paymentCount =
-  R.divClass "g-HeaderInfos__Repartition" $ do
+  R.divClass "g-PaymentHeaderInfos__Repartition" $ do
 
     R.elClass "span" "total" $ do
       R.text $
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index f47b627..6bc1614 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -3,6 +3,7 @@ module View.Payment.Payment
   , In(..)
   ) where
 
+import           Control.Monad.IO.Class   (liftIO)
 import qualified Data.Maybe               as Maybe
 import           Data.Text                (Text)
 import qualified Data.Text                as T
@@ -12,9 +13,8 @@ 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)
+                                           Payment (..), PaymentId,
+                                           PaymentPage (..), User, UserId)
 import qualified Common.Util.Text         as T
 
 import qualified Component.Pages          as Pages
@@ -22,8 +22,8 @@ import           Loadable                 (Loadable (..))
 import qualified Loadable
 import qualified Util.Ajax                as AjaxUtil
 import qualified Util.Reflex              as ReflexUtil
+import qualified View.Payment.HeaderForm  as HeaderForm
 import qualified View.Payment.HeaderInfos as HeaderInfos
--- import qualified View.Payment.HeaderForm as HeaderForm
 import qualified View.Payment.Reducer     as Reducer
 import qualified View.Payment.Table       as Table
 
@@ -36,15 +36,16 @@ data In t = In
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input = do
 
-  categoriesEvent <- (AjaxUtil.getNow "api/categories")
+  categories <- AjaxUtil.getNow "api/categories"
 
-  R.dyn . R.ffor categoriesEvent . Loadable.view $ \categories -> do
+  R.dyn . R.ffor categories . 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_page          = page
+        , Reducer._in_search        = HeaderForm._out_search form
+        , Reducer._in_frequency     = HeaderForm._out_frequency form
+        , Reducer._in_addPayment    = addPayment
         , Reducer._in_editPayment   = editPayment
         , Reducer._in_deletePayment = deletePayment
         }
@@ -52,16 +53,25 @@ view input = do
       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
+      let addPayment =
+            R.leftmost
+              [ tableAddPayment
+              , HeaderForm._out_addPayment form
+              ]
+
+      page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
       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 header payments paymentCategories count) -> do
+      form <- HeaderForm.view $ HeaderForm.In
+        { HeaderForm._in_reset             = () <$ addPayment
+        , HeaderForm._in_categories        = categories
+        }
+
+      result <- R.dyn . R.ffor payments $
+        Loadable.view $ \(PaymentPage page header payments count) -> do
+
           HeaderInfos.view $ HeaderInfos.In
             { HeaderInfos._in_users = _in_users input
             , HeaderInfos._in_currency = _in_currency input
@@ -75,13 +85,12 @@ view input = do
             , 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
+            , Pages._in_page = page
             }
 
           return ((), table, pages)
@@ -89,137 +98,3 @@ view input = do
     return ()
 
   return ()
-
-
--- 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
index 0c70f8a..0b6c041 100644
--- a/client/src/View/Payment/Reducer.hs
+++ b/client/src/View/Payment/Reducer.hs
@@ -2,14 +2,16 @@ module View.Payment.Reducer
   ( perPage
   , reducer
   , In(..)
+  , Params(..)
   ) where
 
 import           Data.Text    (Text)
 import qualified Data.Text    as T
+import           Data.Time    (NominalDiffTime)
 import           Reflex.Dom   (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom   as R
 
-import           Common.Model (PaymentPage)
+import           Common.Model (Frequency (..), PaymentPage)
 
 import           Loadable     (Loadable (..))
 import qualified Loadable     as Loadable
@@ -19,48 +21,99 @@ perPage :: Int
 perPage = 7
 
 data In t a b c = In
-  { _in_newPage       :: Event t Int
-  , _in_currentPage   :: Dynamic t Int
+  { _in_page          :: Event t Int
+  , _in_search        :: Event t Text
+  , _in_frequency     :: Event t Frequency
   , _in_addPayment    :: Event t a
   , _in_editPayment   :: Event t b
   , _in_deletePayment :: Event t c
   }
 
 data Action
-  = LoadPage Int
+  = LoadPage
   | GetResult (Either Text PaymentPage)
 
+data Params = Params
+  { _params_page      :: Int
+  , _params_search    :: Text
+  , _params_frequency :: Frequency
+  } deriving (Show)
+
+initParams = Params 1 "" Punctual
+
+data Msg
+  = Page Int
+  | Search Text
+  | Frequency Common.Model.Frequency
+  | ResetSearch
+  deriving Show
+
 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 =
+  debouncedSearch <- R.debounce (1 :: NominalDiffTime) (_in_search input)
+
+  params <- R.foldDynMaybe
+    (\msg params -> case msg of
+      Page page     ->
+        Just $ params { _params_page = page }
+
+      Search ""     ->
+        if _params_search params == "" then
+          Nothing
+
+        else
+          Just $ initParams { _params_frequency = _params_frequency params }
+
+      Search search ->
+        Just $ params { _params_search = search, _params_page = _params_page initParams }
+
+      Frequency frequency ->
+        Just $ params { _params_frequency = frequency }
+
+      ResetSearch   ->
+        Just $ initParams { _params_frequency = _params_frequency params }
+    )
+    initParams
+    (R.leftmost
+      [ Page <$> _in_page input
+      , Search <$> debouncedSearch
+      , Frequency <$> _in_frequency input
+      , ResetSearch <$ _in_addPayment input
+      ])
+
+  let paramsEvent =
         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)
+          [ initParams <$ postBuild
+          , R.updated params
+          , R.tag (R.current params) (_in_editPayment input)
+          , R.tag (R.current params) (_in_deletePayment input)
           ]
 
-  getResult <- AjaxUtil.get $ fmap pageUrl loadPage
+  getResult <- AjaxUtil.get (pageUrl <$> paramsEvent)
+
 
   R.foldDyn
     (\action _ -> case action of
-      LoadPage _                 -> Loading
+      LoadPage                   -> Loading
       GetResult (Left err)       -> Error err
       GetResult (Right payments) -> Loaded payments
     )
     Loading
     (R.leftmost
-      [ LoadPage <$> loadPage
+      [ LoadPage <$ paramsEvent
       , GetResult <$> getResult
       ])
 
   where
-    pageUrl p =
+    pageUrl (Params page search frequency) =
       "api/payments?page="
-      <> (T.pack . show $ p)
+      <> (T.pack . show $ page)
       <> "&perPage="
       <> (T.pack . show $ perPage)
+      <> "&search="
+      <> search
+      <> "&frequency="
+      <> (T.pack $ show frequency)
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index dde5168..59ac890 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -13,7 +13,6 @@ 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
@@ -26,17 +25,16 @@ import qualified Util.Either             as EitherUtil
 import qualified View.Payment.Form       as Form
 
 data In t = In
-  { _in_users             :: [User]
-  , _in_currentUser       :: UserId
-  , _in_categories        :: [Category]
-  , _in_currency          :: Currency
-  , _in_payments          :: [Payment]
-  , _in_paymentCategories :: [PaymentCategory]
+  { _in_users       :: [User]
+  , _in_currentUser :: UserId
+  , _in_categories  :: [Category]
+  , _in_currency    :: Currency
+  , _in_payments    :: [Payment]
   }
 
 data Out t = Out
-  { _out_add    :: Event t SavedPayment
-  , _out_edit   :: Event t SavedPayment
+  { _out_add    :: Event t Payment
+  , _out_edit   :: Event t Payment
   , _out_delete :: Event t Payment
   }
 
@@ -50,18 +48,15 @@ view input = do
       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
         }
     , 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
         }
     , Table._in_deleteModal = \payment ->
@@ -101,12 +96,11 @@ cell
   :: forall t m. MonadWidget t m
   => [User]
   -> [Category]
-  -> [PaymentCategory]
   -> Currency
   -> Header
   -> Payment
   -> m ()
-cell users categories paymentCategories currency header payment =
+cell users categories currency header payment =
   case header of
     NameHeader ->
       R.text $ _payment_name payment
@@ -120,7 +114,7 @@ cell users categories paymentCategories currency header payment =
     CategoryHeader ->
       let
         category =
-          findCategory categories paymentCategories (_payment_name payment)
+          L.find ((== (_payment_category payment)) . _category_id) categories
 
         attrs =
           case category of
@@ -144,10 +138,3 @@ cell users categories paymentCategories currency header payment =
 
         R.elClass "span" "longDate" $
           R.text . Format.longDay . _payment_date $ payment
-
-findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
-findCategory categories paymentCategories paymentName = do
-  paymentCategory <- L.find
-    ((== T.toLower paymentName) . _paymentCategory_name)
-    paymentCategories
-  L.find ((== (_paymentCategory_category paymentCategory)) . _category_id) categories
-- 
cgit v1.2.3


From 3c67fcf1d524811a18f0c4db3ef6eed1270b9a12 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 17 Nov 2019 19:55:22 +0100
Subject: Hide date from monthly payments

---
 client/src/View/Payment/Form.hs       | 51 +++++++++++++++++++----------------
 client/src/View/Payment/HeaderForm.hs | 20 ++++++++------
 client/src/View/Payment/Payment.hs    |  3 ++-
 client/src/View/Payment/Table.hs      | 40 ++++++++++++++++-----------
 4 files changed, 67 insertions(+), 47 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 6c3c1e8..99dce13 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -43,10 +43,11 @@ import qualified Util.Validation           as ValidationUtil
 data In t = In
   { _in_categories :: [Category]
   , _in_operation  :: Operation t
+  , _in_frequency  :: Frequency
   }
 
 data Operation t
-  = New (Dynamic t Frequency)
+  = New
   | Clone Payment
   | Edit Payment
 
@@ -92,18 +93,23 @@ view input cancel = do
         (cost <$ reset)
         confirm)
 
-      d <- date
-
-      date <- Input._out_raw <$> (Input.view
-        (Input.defaultIn
-          { Input._in_label = Msg.get Msg.Payment_Date
-          , Input._in_initialValue = d
-          , Input._in_inputType = "date"
-          , Input._in_hasResetButton = False
-          , Input._in_validation = PaymentValidation.date
-          })
-        (d <$ reset)
-        confirm)
+      currentDate <- date
+
+      date <-
+        case frequency of
+          Punctual -> do
+            Input._out_raw <$> (Input.view
+              (Input.defaultIn
+                { Input._in_label = Msg.get Msg.Payment_Date
+                , Input._in_initialValue = currentDate
+                , Input._in_inputType = "date"
+                , Input._in_hasResetButton = False
+                , Input._in_validation = PaymentValidation.date
+                })
+              (currentDate <$ reset)
+              confirm)
+          Monthly ->
+            return . R.constDyn $ currentDate
 
       setCategory <-
         R.debounce  (1 :: NominalDiffTime) (R.updated $ Input._out_raw name)
@@ -125,13 +131,12 @@ view input cancel = do
         c <- cost
         d <- date
         cat <- category
-        f <- frequency
         return (mkPayload
           <$> ValidationUtil.nelError n
           <*> V.Success c
           <*> V.Success d
           <*> ValidationUtil.nelError cat
-          <*> V.Success f)
+          <*> V.Success frequency)
 
     frequencies =
       M.fromList
@@ -144,7 +149,7 @@ view input cancel = do
 
     category =
       case op of
-        New _   -> -1
+        New     -> -1
         Clone p -> _payment_category p
         Edit p  -> _payment_category p
 
@@ -152,13 +157,13 @@ view input cancel = do
 
     name =
       case op of
-        New _   -> ""
+        New     -> ""
         Clone p -> _payment_name p
         Edit p  -> _payment_name p
 
     cost =
       case op of
-        New _   -> ""
+        New     -> ""
         Clone p -> T.pack . show . _payment_cost $ p
         Edit p  -> T.pack . show . _payment_cost $ p
 
@@ -166,19 +171,19 @@ view input cancel = do
       currentDay <- liftIO $ Clock.getCurrentTime >>= TimeUtil.timeToDay
       return . T.pack . Calendar.showGregorian $
         case op of
-          New _   -> currentDay
+          New     -> currentDay
           Clone p -> currentDay
           Edit p  -> _payment_date p
 
     frequency =
       case op of
-        New f   -> f
-        Clone p -> R.constDyn $ _payment_frequency p
-        Edit p  -> R.constDyn $ _payment_frequency p
+        New     -> _in_frequency input
+        Clone p -> _payment_frequency p
+        Edit p  -> _payment_frequency p
 
     headerLabel =
       case op of
-        New _   -> Msg.get Msg.Payment_Add
+        New     -> Msg.get Msg.Payment_Add
         Clone _ -> Msg.get Msg.Payment_CloneLong
         Edit _  -> Msg.get Msg.Payment_EditLong
 
diff --git a/client/src/View/Payment/HeaderForm.hs b/client/src/View/Payment/HeaderForm.hs
index c8ca4d9..0ee0cd3 100644
--- a/client/src/View/Payment/HeaderForm.hs
+++ b/client/src/View/Payment/HeaderForm.hs
@@ -18,6 +18,7 @@ import qualified Component.Button  as Button
 import qualified Component.Input   as Input
 import qualified Component.Modal   as Modal
 import qualified Component.Select  as Select
+import qualified Util.Reflex       as ReflexUtil
 import qualified View.Payment.Form as Form
 
 data In t = In
@@ -65,14 +66,17 @@ view input =
           { Button._in_class = R.constDyn "addPayment"
           })
 
-    addPayment <- Modal.view $ Modal.In
-      { Modal._in_show    = addPaymentButton
-      , Modal._in_content =
-        Form.view $ Form.In
-          { Form._in_categories = _in_categories input
-          , Form._in_operation = Form.New frequency
-          }
-      }
+    addPayment <-
+      (R.dyn . R.ffor frequency $ \frequency ->
+        Modal.view $ Modal.In
+          { Modal._in_show    = addPaymentButton
+          , Modal._in_content =
+            Form.view $ Form.In
+              { Form._in_categories = _in_categories input
+              , Form._in_operation = Form.New
+              , Form._in_frequency = frequency
+              }
+          }) >>= ReflexUtil.flatten
 
     return $ Out
       { _out_search = R.updated searchName
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index 6bc1614..a34d2f4 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -70,7 +70,7 @@ view input = do
         }
 
       result <- R.dyn . R.ffor payments $
-        Loadable.view $ \(PaymentPage page header payments count) -> do
+        Loadable.view $ \(PaymentPage page frequency header payments count) -> do
 
           HeaderInfos.view $ HeaderInfos.In
             { HeaderInfos._in_users = _in_users input
@@ -85,6 +85,7 @@ view input = do
             , Table._in_categories = categories
             , Table._in_currency = _in_currency input
             , Table._in_payments = payments
+            , Table._in_frequency = frequency
             }
 
           pages <- Pages.view $ Pages.In
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 59ac890..f9215bc 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -12,7 +12,8 @@ import qualified Data.Text               as T
 import           Reflex.Dom              (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom              as R
 
-import           Common.Model            (Category (..), Currency, Payment (..),
+import           Common.Model            (Category (..), Currency,
+                                          Frequency (..), Payment (..),
                                           User (..), UserId)
 import qualified Common.Model            as CM
 import qualified Common.Msg              as Msg
@@ -30,6 +31,7 @@ data In t = In
   , _in_categories  :: [Category]
   , _in_currency    :: Currency
   , _in_payments    :: [Payment]
+  , _in_frequency   :: Frequency
   }
 
 data Out t = Out
@@ -42,22 +44,25 @@ view :: forall t m. MonadWidget t m => In t -> m (Out t)
 view input = do
 
   table <- Table.view $ Table.In
-    { Table._in_headerLabel = headerLabel
+    { Table._in_headerLabel = headerLabel (_in_frequency input)
     , Table._in_rows = reverse . L.sortOn _payment_date $ _in_payments input
     , Table._in_cell =
       cell
         (_in_users input)
         (_in_categories input)
+        (_in_frequency input)
         (_in_currency input)
     , Table._in_cloneModal = \payment ->
       Form.view $ Form.In
         { Form._in_categories = _in_categories input
         , Form._in_operation = Form.Clone payment
+        , Form._in_frequency = _in_frequency input
         }
     , Table._in_editModal = \payment ->
       Form.view $ Form.In
         { Form._in_categories = _in_categories input
         , Form._in_operation = Form.Edit payment
+        , Form._in_frequency = _in_frequency input
         }
     , Table._in_deleteModal = \payment ->
       ConfirmDialog.view $ ConfirmDialog.In
@@ -85,22 +90,24 @@ data Header
   | 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
+headerLabel :: Frequency -> 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 Punctual DateHeader = Msg.get Msg.Payment_Date
+headerLabel Monthly DateHeader  = ""
 
 cell
   :: forall t m. MonadWidget t m
   => [User]
   -> [Category]
+  -> Frequency
   -> Currency
   -> Header
   -> Payment
   -> m ()
-cell users categories currency header payment =
+cell users categories frequency currency header payment =
   case header of
     NameHeader ->
       R.text $ _payment_name payment
@@ -132,9 +139,12 @@ cell users categories currency header payment =
             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
+      if frequency == Punctual then
+        do
+          R.elClass "span" "shortDate" $
+            R.text . Format.shortDay . _payment_date $ payment
+
+          R.elClass "span" "longDate" $
+            R.text . Format.longDay . _payment_date $ payment
+      else
+        R.blank
-- 
cgit v1.2.3


From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Nov 2019 16:19:53 +0100
Subject: Compute cumulative income with a DB query

---
 client/src/View/Payment/Form.hs    |  1 +
 client/src/View/Payment/Payment.hs | 18 +++++++++---------
 client/src/View/Payment/Reducer.hs | 30 +++++++++++++-----------------
 3 files changed, 23 insertions(+), 26 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 99dce13..064b5b3 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -113,6 +113,7 @@ view input cancel = do
 
       setCategory <-
         R.debounce  (1 :: NominalDiffTime) (R.updated $ Input._out_raw name)
+          >>= (return . R.ffilter (\name -> T.length name >= 3))
           >>= (Ajax.get . (fmap ("/api/payment/category?name=" <>)))
           >>= (return . R.mapMaybe (join . EitherUtil.eitherToMaybe))
 
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index a34d2f4..a97c3df 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -41,7 +41,7 @@ view input = do
   R.dyn . R.ffor categories . Loadable.view $ \categories -> do
 
     rec
-      payments <- Reducer.reducer $ Reducer.In
+      paymentPage <- Reducer.reducer $ Reducer.In
         { Reducer._in_page          = page
         , Reducer._in_search        = HeaderForm._out_search form
         , Reducer._in_frequency     = HeaderForm._out_frequency form
@@ -50,7 +50,7 @@ view input = do
         , Reducer._in_deletePayment = deletePayment
         }
 
-      let eventFromResult :: forall a. (((), Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
+      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
 
       let addPayment =
@@ -59,18 +59,18 @@ view input = do
               , HeaderForm._out_addPayment form
               ]
 
-      page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
-      tableAddPayment <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
-      editPayment <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
-      deletePayment <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
+      page <- eventFromResult $ Pages._out_newPage . snd
+      tableAddPayment <- eventFromResult $ Table._out_add . fst
+      editPayment <- eventFromResult $ Table._out_edit . fst
+      deletePayment <- eventFromResult $ Table._out_delete . fst
 
       form <- HeaderForm.view $ HeaderForm.In
         { HeaderForm._in_reset             = () <$ addPayment
         , HeaderForm._in_categories        = categories
         }
 
-      result <- R.dyn . R.ffor payments $
-        Loadable.view $ \(PaymentPage page frequency header payments count) -> do
+      result <- Loadable.view2 paymentPage $
+        \(PaymentPage page frequency header payments count) -> do
 
           HeaderInfos.view $ HeaderInfos.In
             { HeaderInfos._in_users = _in_users input
@@ -94,7 +94,7 @@ view input = do
             , Pages._in_page = page
             }
 
-          return ((), table, pages)
+          return (table, pages)
 
     return ()
 
diff --git a/client/src/View/Payment/Reducer.hs b/client/src/View/Payment/Reducer.hs
index 0b6c041..d221ff0 100644
--- a/client/src/View/Payment/Reducer.hs
+++ b/client/src/View/Payment/Reducer.hs
@@ -13,9 +13,9 @@ import qualified Reflex.Dom   as R
 
 import           Common.Model (Frequency (..), PaymentPage)
 
-import           Loadable     (Loadable (..))
-import qualified Loadable     as Loadable
+import           Loadable     (Loadable2 (..))
 import qualified Util.Ajax    as AjaxUtil
+import qualified Util.Either  as EitherUtil
 
 perPage :: Int
 perPage = 7
@@ -29,10 +29,6 @@ data In t a b c = In
   , _in_deletePayment :: Event t c
   }
 
-data Action
-  = LoadPage
-  | GetResult (Either Text PaymentPage)
-
 data Params = Params
   { _params_page      :: Int
   , _params_search    :: Text
@@ -48,7 +44,7 @@ data Msg
   | ResetSearch
   deriving Show
 
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable PaymentPage))
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t PaymentPage)
 reducer input = do
 
   postBuild <- R.getPostBuild
@@ -94,19 +90,19 @@ reducer input = do
 
   getResult <- AjaxUtil.get (pageUrl <$> paramsEvent)
 
-
-  R.foldDyn
-    (\action _ -> case action of
-      LoadPage                   -> Loading
-      GetResult (Left err)       -> Error err
-      GetResult (Right payments) -> Loaded payments
-    )
-    Loading
+  isLoading <- R.holdDyn
+    True
     (R.leftmost
-      [ LoadPage <$ paramsEvent
-      , GetResult <$> getResult
+      [ True <$ paramsEvent
+      , False <$ getResult
       ])
 
+  paymentPage <- R.holdDyn
+    Nothing
+    (fmap EitherUtil.eitherToMaybe getResult)
+
+  return $ Loadable2 isLoading paymentPage
+
   where
     pageUrl (Params page search frequency) =
       "api/payments?page="
-- 
cgit v1.2.3


From e622e8fdd2e40b4306b5cc724d8dfb76bf976242 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 25 Nov 2019 08:17:59 +0100
Subject: Remove Loadable2

---
 client/src/View/Payment/Payment.hs |  4 ++--
 client/src/View/Payment/Reducer.hs | 19 +++++++------------
 2 files changed, 9 insertions(+), 14 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index a97c3df..8d0fee1 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -38,7 +38,7 @@ view input = do
 
   categories <- AjaxUtil.getNow "api/categories"
 
-  R.dyn . R.ffor categories . Loadable.view $ \categories -> do
+  R.dyn . R.ffor categories . Loadable.viewHideValueWhileLoading $ \categories -> do
 
     rec
       paymentPage <- Reducer.reducer $ Reducer.In
@@ -69,7 +69,7 @@ view input = do
         , HeaderForm._in_categories        = categories
         }
 
-      result <- Loadable.view2 paymentPage $
+      result <- Loadable.viewShowValueWhileLoading paymentPage $
         \(PaymentPage page frequency header payments count) -> do
 
           HeaderInfos.view $ HeaderInfos.In
diff --git a/client/src/View/Payment/Reducer.hs b/client/src/View/Payment/Reducer.hs
index d221ff0..7468097 100644
--- a/client/src/View/Payment/Reducer.hs
+++ b/client/src/View/Payment/Reducer.hs
@@ -13,7 +13,8 @@ import qualified Reflex.Dom   as R
 
 import           Common.Model (Frequency (..), PaymentPage)
 
-import           Loadable     (Loadable2 (..))
+import           Loadable     (Loadable (..))
+import qualified Loadable     as Loadable
 import qualified Util.Ajax    as AjaxUtil
 import qualified Util.Either  as EitherUtil
 
@@ -44,7 +45,7 @@ data Msg
   | ResetSearch
   deriving Show
 
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t 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
@@ -90,19 +91,13 @@ reducer input = do
 
   getResult <- AjaxUtil.get (pageUrl <$> paramsEvent)
 
-  isLoading <- R.holdDyn
-    True
+  R.holdDyn
+    Loading
     (R.leftmost
-      [ True <$ paramsEvent
-      , False <$ getResult
+      [ Loading <$ paramsEvent
+      , Loadable.fromEither <$> getResult
       ])
 
-  paymentPage <- R.holdDyn
-    Nothing
-    (fmap EitherUtil.eitherToMaybe getResult)
-
-  return $ Loadable2 isLoading paymentPage
-
   where
     pageUrl (Params page search frequency) =
       "api/payments?page="
-- 
cgit v1.2.3


From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 8 Dec 2019 11:39:37 +0100
Subject: Add category page

---
 client/src/View/Payment/Form.hs       |  2 +-
 client/src/View/Payment/HeaderForm.hs |  2 +-
 client/src/View/Payment/Payment.hs    |  2 +-
 client/src/View/Payment/Table.hs      | 30 +++++++++++-------------------
 4 files changed, 14 insertions(+), 22 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 064b5b3..6c31fad 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -51,7 +51,7 @@ data Operation t
   | Clone Payment
   | Edit Payment
 
-view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m Payment
+view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m
 view input cancel = do
   rec
     let reset = R.leftmost
diff --git a/client/src/View/Payment/HeaderForm.hs b/client/src/View/Payment/HeaderForm.hs
index 0ee0cd3..1915841 100644
--- a/client/src/View/Payment/HeaderForm.hs
+++ b/client/src/View/Payment/HeaderForm.hs
@@ -29,7 +29,7 @@ data In t = In
 data Out t = Out
   { _out_search     :: Event t Text
   , _out_frequency  :: Event t Frequency
-  , _out_addPayment :: Event t Payment
+  , _out_addPayment :: Event t ()
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index 8d0fee1..26444d7 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -36,7 +36,7 @@ data In t = In
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input = do
 
-  categories <- AjaxUtil.getNow "api/categories"
+  categories <- AjaxUtil.getNow "api/allCategories"
 
   R.dyn . R.ffor categories . Loadable.viewHideValueWhileLoading $ \categories -> do
 
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index f9215bc..6744d3a 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -21,6 +21,7 @@ import qualified Common.View.Format      as Format
 
 import qualified Component.ConfirmDialog as ConfirmDialog
 import qualified Component.Table         as Table
+import qualified Component.Tag           as Tag
 import qualified Util.Ajax               as Ajax
 import qualified Util.Either             as EitherUtil
 import qualified View.Payment.Form       as Form
@@ -35,9 +36,9 @@ data In t = In
   }
 
 data Out t = Out
-  { _out_add    :: Event t Payment
-  , _out_edit   :: Event t Payment
-  , _out_delete :: Event t Payment
+  { _out_add    :: Event t ()
+  , _out_edit   :: Event t ()
+  , _out_delete :: Event t ()
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
@@ -45,7 +46,7 @@ view input = do
 
   table <- Table.view $ Table.In
     { Table._in_headerLabel = headerLabel (_in_frequency input)
-    , Table._in_rows = reverse . L.sortOn _payment_date $ _in_payments input
+    , Table._in_rows = _in_payments input
     , Table._in_cell =
       cell
         (_in_users input)
@@ -71,7 +72,7 @@ view input = do
           res <- Ajax.delete
             (R.constDyn $ T.concat ["/api/payment/", T.pack . show $ _payment_id payment])
             e
-          return $ payment <$ R.fmapMaybe EitherUtil.eitherToMaybe res
+          return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
         }
     , Table._in_isOwner = (== (_in_currentUser input)) . _payment_user
     }
@@ -122,21 +123,12 @@ cell users categories frequency currency header payment =
       let
         category =
           L.find ((== (_payment_category payment)) . _category_id) categories
-
-        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)
+        Maybe.fromMaybe R.blank . flip fmap category $ \c ->
+          Tag.view $ Tag.In
+            { Tag._in_text = _category_name c
+            , Tag._in_color = _category_color c
+            }
 
     DateHeader ->
       if frequency == Punctual then
-- 
cgit v1.2.3


From da2a0c13aa89705c65fdb9df2f496fb4eea29654 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 4 Jan 2020 19:22:45 +0100
Subject: Allow to remove only unused categories

---
 client/src/View/Payment/Table.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 6744d3a..bfa0fb9 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -74,7 +74,8 @@ view input = do
             e
           return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
         }
-    , Table._in_isOwner = (== (_in_currentUser input)) . _payment_user
+    , Table._in_canEdit = (== (_in_currentUser input)) . _payment_user
+    , Table._in_canDelete = (== (_in_currentUser input)) . _payment_user
     }
 
   return $ Out
-- 
cgit v1.2.3


From cdb0ae1aeb22d7d7c36acb9d580f3723aa469829 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 4 Jan 2020 19:26:08 +0100
Subject: Go to page 1 when switching the search frequency

---
 client/src/View/Payment/Reducer.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Reducer.hs b/client/src/View/Payment/Reducer.hs
index 7468097..3fe59b2 100644
--- a/client/src/View/Payment/Reducer.hs
+++ b/client/src/View/Payment/Reducer.hs
@@ -68,7 +68,7 @@ reducer input = do
         Just $ params { _params_search = search, _params_page = _params_page initParams }
 
       Frequency frequency ->
-        Just $ params { _params_frequency = frequency }
+        Just $ params { _params_frequency = frequency, _params_page = _params_page initParams }
 
       ResetSearch   ->
         Just $ initParams { _params_frequency = _params_frequency params }
-- 
cgit v1.2.3