diff options
Diffstat (limited to 'client/src/View/Payment/Add.hs')
-rw-r--r-- | client/src/View/Payment/Add.hs | 22 |
1 files changed, 13 insertions, 9 deletions
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 |