aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment/Form.hs
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View/Payment/Form.hs')
-rw-r--r--client/src/View/Payment/Form.hs52
1 files changed, 24 insertions, 28 deletions
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)