diff options
Diffstat (limited to 'client/src/View/Income')
| -rw-r--r-- | client/src/View/Income/Add.hs | 3 | ||||
| -rw-r--r-- | client/src/View/Income/Form.hs | 138 |
2 files changed, 59 insertions, 82 deletions
diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs index d83bb51..0b1bd04 100644 --- a/client/src/View/Income/Add.hs +++ b/client/src/View/Income/Add.hs @@ -11,6 +11,7 @@ import Common.Model (CreateIncomeForm (..), Income) import qualified Common.Msg as Msg import qualified Common.Util.Time as TimeUtil import qualified Component.Modal as Modal +import qualified Util.Ajax as Ajax import qualified Util.Reflex as ReflexUtil import View.Income.Form (FormIn (..), FormOut (..)) import qualified View.Income.Form as Form @@ -27,7 +28,7 @@ view cancel = do , _formIn_amount = "" , _formIn_date = currentDay , _formIn_mkPayload = CreateIncomeForm - , _formIn_httpMethod = Form.Post + , _formIn_ajax = Ajax.post } hide <- ReflexUtil.flatten (_formOut_hide <$> form) diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs index 2bfc23f..824bb0a 100644 --- a/client/src/View/Income/Form.hs +++ b/client/src/View/Income/Form.hs @@ -1,113 +1,89 @@ module View.Income.Form ( view , FormIn(..) - , HttpMethod(..) , FormOut(..) ) where -import Data.Aeson (ToJSON) +import Data.Aeson (FromJSON, ToJSON) 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 (Event, MonadWidget) +import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R import Common.Model (Income) import qualified Common.Msg as Msg import qualified Common.Validation.Income as IncomeValidation -import Component (ButtonIn (..), InputIn (..), - InputOut (..)) +import Component (InputIn (..), InputOut (..), + ModalFormIn (..), ModalFormOut (..)) 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 FormIn t i = FormIn +data FormIn m t a = FormIn { _formIn_cancel :: Event t () , _formIn_headerLabel :: Text , _formIn_amount :: Text , _formIn_date :: Day - , _formIn_mkPayload :: Text -> Text -> i - , _formIn_httpMethod :: HttpMethod + , _formIn_mkPayload :: Text -> Text -> a + , _formIn_ajax :: Text -> Event t a -> m (Event t (Either Text Income)) } -data HttpMethod = Put | Post - data FormOut t = FormOut { _formOut_hide :: Event t () , _formOut_addIncome :: Event t Income } -view :: forall t m i. (MonadWidget t m, ToJSON i) => FormIn t i -> m (FormOut t) +view :: forall t m a. (MonadWidget t m, ToJSON a) => FormIn m t a -> m (FormOut t) view formIn = do - R.divClass "form" $ do - R.divClass "formHeader" $ - R.text (_formIn_headerLabel formIn) - - R.divClass "formContent" $ do - rec - let reset = R.leftmost - [ "" <$ cancel - , "" <$ addIncome - , "" <$ _formIn_cancel formIn - ] - - amount <- _inputOut_raw <$> (Component.input - (Component.defaultInputIn - { _inputIn_label = Msg.get Msg.Income_Amount - , _inputIn_initialValue = _formIn_amount formIn - , _inputIn_validation = IncomeValidation.amount - }) - (_formIn_amount formIn <$ reset) - confirm) - - let initialDate = T.pack . Calendar.showGregorian . _formIn_date $ formIn - - date <- _inputOut_raw <$> (Component.input - (Component.defaultInputIn - { _inputIn_label = Msg.get Msg.Income_Date - , _inputIn_initialValue = initialDate - , _inputIn_inputType = "date" - , _inputIn_hasResetButton = False - , _inputIn_validation = IncomeValidation.date - }) - (initialDate <$ reset) - confirm) - - let income = do - a <- amount - d <- date - return . V.Success $ (_formIn_mkPayload formIn) a d - - (addIncome, 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 - }) - - (addIncome, waiting) <- WaitFor.waitFor - (ajax "/api/income") - (ValidationUtil.fireValidation income confirm) - - return (R.fmapMaybe EitherUtil.eitherToMaybe addIncome, cancel, confirm) - - return FormOut - { _formOut_hide = R.leftmost [ cancel, () <$ addIncome ] - , _formOut_addIncome = addIncome - } + rec + let reset = R.leftmost + [ "" <$ _modalFormOut_cancel modalForm + , "" <$ _modalFormOut_validate modalForm + , "" <$ _formIn_cancel formIn + ] + + modalForm <- Component.modalForm $ ModalFormIn + { _modalFormIn_headerLabel = _formIn_headerLabel formIn + , _modalFormIn_ajax = _formIn_ajax formIn "/api/income" + , _modalFormIn_form = form reset (_modalFormOut_confirm modalForm) + } + + return $ FormOut + { _formOut_hide = _modalFormOut_hide modalForm + , _formOut_addIncome = _modalFormOut_validate modalForm + } where - ajax = - case _formIn_httpMethod formIn of - Post -> Ajax.post - Put -> Ajax.put + form + :: Event t String + -> Event t () + -> m (Dynamic t (Validation Text a)) + form reset confirm = do + amount <- _inputOut_raw <$> (Component.input + (Component.defaultInputIn + { _inputIn_label = Msg.get Msg.Income_Amount + , _inputIn_initialValue = _formIn_amount formIn + , _inputIn_validation = IncomeValidation.amount + }) + (_formIn_amount formIn <$ reset) + confirm) + + let initialDate = T.pack . Calendar.showGregorian . _formIn_date $ formIn + + date <- _inputOut_raw <$> (Component.input + (Component.defaultInputIn + { _inputIn_label = Msg.get Msg.Income_Date + , _inputIn_initialValue = initialDate + , _inputIn_inputType = "date" + , _inputIn_hasResetButton = False + , _inputIn_validation = IncomeValidation.date + }) + (initialDate <$ reset) + confirm) + + return $ do + a <- amount + d <- date + return . V.Success $ (_formIn_mkPayload formIn) a d |