diff options
Diffstat (limited to 'client/src/View/Income/Form.hs')
-rw-r--r-- | client/src/View/Income/Form.hs | 89 |
1 files changed, 61 insertions, 28 deletions
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs index 917edf1..5f354a2 100644 --- a/client/src/View/Income/Form.hs +++ b/client/src/View/Income/Form.hs @@ -1,60 +1,59 @@ module View.Income.Form ( view , In(..) - , Out(..) + , Operation(..) ) where -import Data.Aeson (FromJSON, ToJSON) +import Control.Monad.IO.Class (liftIO) +import Data.Aeson (ToJSON) +import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Calendar (Day) import qualified Data.Time.Calendar as Calendar +import qualified Data.Time.Clock as Time import Data.Validation (Validation) import qualified Data.Validation as V import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Income) +import Common.Model (EditIncomeForm (..), Income (..)) import qualified Common.Msg as Msg +import qualified Common.Util.Time as TimeUtil import qualified Common.Validation.Income as IncomeValidation import qualified Component.Input as Input +import qualified Component.Modal as Modal import qualified Component.ModalForm as ModalForm +import qualified Util.Ajax as Ajax -data In m t a = In - { _in_cancel :: Event t () - , _in_headerLabel :: Text - , _in_amount :: Text - , _in_date :: Day - , _in_mkPayload :: Text -> Text -> a - , _in_ajax :: Text -> Event t a -> m (Event t (Either Text Income)) +data In t a = In + { _in_operation :: Operation a } -data Out t = Out - { _out_hide :: Event t () - , _out_addIncome :: Event t Income - } +data Operation a + = New (Text -> Text -> a) + | Clone (Text -> Text -> a) Income + | Edit (Text -> Text -> a) Income + +view :: forall t m a. (MonadWidget t m, ToJSON a) => In t a -> Modal.Content t m Income +view input cancel = do -view :: forall t m a. (MonadWidget t m, ToJSON a) => In m t a -> m (Out t) -view input = do rec let reset = R.leftmost [ "" <$ ModalForm._out_cancel modalForm , "" <$ ModalForm._out_validate modalForm - , "" <$ _in_cancel input + , "" <$ cancel ] modalForm <- ModalForm.view $ ModalForm.In - { ModalForm._in_headerLabel = _in_headerLabel input - , ModalForm._in_ajax = _in_ajax input "/api/income" + { ModalForm._in_headerLabel = headerLabel + , ModalForm._in_ajax = ajax "/api/income" , ModalForm._in_form = form reset (ModalForm._out_confirm modalForm) } - return $ Out - { _out_hide = ModalForm._out_hide modalForm - , _out_addIncome = ModalForm._out_validate modalForm - } + return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm) where + form :: Event t String -> Event t () @@ -63,13 +62,15 @@ view input = do amount <- Input._out_raw <$> (Input.view (Input.defaultIn { Input._in_label = Msg.get Msg.Income_Amount - , Input._in_initialValue = _in_amount input + , Input._in_initialValue = amount , Input._in_validation = IncomeValidation.amount }) - (_in_amount input <$ reset) + (amount <$ reset) confirm) - let initialDate = T.pack . Calendar.showGregorian . _in_date $ input + currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay + + let initialDate = T.pack . Calendar.showGregorian $ date currentDay date <- Input._out_raw <$> (Input.view (Input.defaultIn @@ -85,4 +86,36 @@ view input = do return $ do a <- amount d <- date - return . V.Success $ (_in_mkPayload input) a d + return . V.Success $ mkPayload a d + + op = _in_operation input + + amount = + case op of + New _ -> "" + Clone _ income -> T.pack . show . _income_amount $ income + Edit _ income -> T.pack . show . _income_amount $ income + + date currentDay = + case op of + New _ -> currentDay + Clone _ _ -> currentDay + Edit _ income -> _income_date income + + ajax = + case op of + New _ -> Ajax.post + Clone _ _ -> Ajax.post + Edit _ _ -> Ajax.put + + headerLabel = + case op of + New _ -> Msg.get Msg.Income_AddLong + Clone _ _ -> Msg.get Msg.Income_AddLong + Edit _ _ -> Msg.get Msg.Income_Edit + + mkPayload = + case op of + New f -> f + Clone f _ -> f + Edit f _ -> f |