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