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/Form.hs | 165 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 165 insertions(+)
 create mode 100644 client/src/View/Payment/Form.hs

(limited to 'client/src/View/Payment/Form.hs')

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)
-- 
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/Form.hs | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

(limited to 'client/src/View/Payment/Form.hs')

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 =
-- 
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/Form.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

(limited to 'client/src/View/Payment/Form.hs')

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))
 
-- 
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/Form.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'client/src/View/Payment/Form.hs')

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 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 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'client/src/View/Payment/Form.hs')

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 =
-- 
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/Form.hs | 205 ++++++++++++++++++----------------------
 1 file changed, 90 insertions(+), 115 deletions(-)

(limited to 'client/src/View/Payment/Form.hs')

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/Form.hs | 129 ++++++++++++++++++++--------------------
 1 file changed, 64 insertions(+), 65 deletions(-)

(limited to 'client/src/View/Payment/Form.hs')

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
-- 
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/Form.hs | 137 +++++++++++++++++++++++++++-------------
 1 file changed, 93 insertions(+), 44 deletions(-)

(limited to 'client/src/View/Payment/Form.hs')

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)
-- 
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 +++++++++++++++++++----------------------
 1 file changed, 24 insertions(+), 28 deletions(-)

(limited to 'client/src/View/Payment/Form.hs')

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)
-- 
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 ++++++++++++++++++++++-------------------
 1 file changed, 28 insertions(+), 23 deletions(-)

(limited to 'client/src/View/Payment/Form.hs')

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
 
-- 
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 +
 1 file changed, 1 insertion(+)

(limited to 'client/src/View/Payment/Form.hs')

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))
 
-- 
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 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'client/src/View/Payment/Form.hs')

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