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

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

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