From f968c8ce63e1aec119b1e6f414cf27e2c0294bcb Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 23 Oct 2019 21:09:54 +0200 Subject: Delete income --- client/src/View/App.hs | 3 ++- client/src/View/Income/Add.hs | 22 ++++++++-------- client/src/View/Income/Header.hs | 6 ++--- client/src/View/Income/Income.hs | 33 +++++++++++++++++------- client/src/View/Income/Table.hs | 54 ++++++++++++++++++++++++++------------- client/src/View/Payment/Delete.hs | 1 - 6 files changed, 75 insertions(+), 44 deletions(-) (limited to 'client/src/View') diff --git a/client/src/View/App.hs b/client/src/View/App.hs index e0a52e2..1e26417 100644 --- a/client/src/View/App.hs +++ b/client/src/View/App.hs @@ -69,7 +69,8 @@ signedWidget init route = do IncomeRoute -> do incomeInit <- Income.init Income.view $ Income.In - { Income._in_currency = _init_currency init + { Income._in_currentUser = _init_currentUser init + , Income._in_currency = _init_currency init , Income._in_init = incomeInit } diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs index d07bd45..7780d73 100644 --- a/client/src/View/Income/Add.hs +++ b/client/src/View/Income/Add.hs @@ -7,19 +7,18 @@ import Control.Monad.IO.Class (liftIO) import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Time.Clock as Time -import Reflex.Dom (Dynamic, MonadWidget) -import qualified Reflex.Dom as R +import Reflex.Dom (MonadWidget) import Common.Model (CreateIncomeForm (..), Income (..)) import qualified Common.Msg as Msg import qualified Common.Util.Time as TimeUtil +import qualified Component.Form import qualified Component.Modal as Modal import qualified Util.Ajax as Ajax -import qualified Util.Reflex as ReflexUtil import qualified View.Income.Form as Form data In t = In - { _in_income :: Dynamic t (Maybe Income) + { _in_income :: Maybe Income } view :: forall t m. MonadWidget t m => In t -> Modal.Content t m Income @@ -27,18 +26,17 @@ view input cancel = do currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay - form <- R.dyn $ do - income <- _in_income input - return $ Form.view $ Form.In + let amount = + Maybe.fromMaybe "" ((T.pack . show . _income_amount) <$> (_in_income input)) + + form <- + Component.Form.view $ Form.view $ Form.In { Form._in_cancel = cancel , Form._in_headerLabel = Msg.get Msg.Income_AddLong - , Form._in_amount = Maybe.fromMaybe "" ((T.pack . show . _income_amount) <$> income) + , Form._in_amount = amount , Form._in_date = currentDay , Form._in_mkPayload = CreateIncomeForm , Form._in_ajax = Ajax.post } - hide <- ReflexUtil.flatten (Form._out_hide <$> form) - addIncome <- ReflexUtil.flatten (Form._out_addIncome <$> form) - - return (hide, addIncome) + return (Form._out_hide form, Form._out_addIncome form) diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs index 0360d1f..f17e774 100644 --- a/client/src/View/Income/Header.hs +++ b/client/src/View/Income/Header.hs @@ -29,7 +29,7 @@ data In t = In } data Out t = Out - { _out_addIncome :: Event t Income + { _out_add :: Event t Income } view :: forall t m. MonadWidget t m => In t -> m (Out t) @@ -72,11 +72,11 @@ view input = addIncome <- Modal.view $ Modal.In { Modal._in_show = addIncome - , Modal._in_content = Add.view $ Add.In { Add._in_income = R.constDyn Nothing } + , Modal._in_content = Add.view $ Add.In { Add._in_income = Nothing } } return $ Out - { _out_addIncome = addIncome + { _out_add = addIncome } where diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index b97613d..2784cac 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -6,10 +6,10 @@ module View.Income.Income import Data.Aeson (FromJSON) import Prelude hiding (init) -import Reflex.Dom (Dynamic, MonadWidget) +import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Currency) +import Common.Model (Currency, Income (..), UserId) import Loadable (Loadable (..)) import qualified Loadable @@ -19,8 +19,9 @@ import View.Income.Init (Init (..)) import qualified View.Income.Table as Table data In t = In - { _in_currency :: Currency - , _in_init :: Dynamic t (Loadable Init) + { _in_currentUser :: UserId + , _in_currency :: Currency + , _in_init :: Dynamic t (Loadable Init) } init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init)) @@ -42,13 +43,14 @@ view input = do rec let addIncome = R.leftmost - [ Header._out_addIncome header - , Table._out_addIncome table + [ Header._out_add header + , Table._out_add table ] - incomes <- R.foldDyn - (:) + + incomes <- reduceIncomes (_init_incomes init) addIncome + (Table._out_delete table) header <- Header.view $ Header.In { Header._in_init = init @@ -57,7 +59,8 @@ view input = do } table <- Table.view $ Table.In - { Table._in_init = init + { Table._in_currentUser = _in_currentUser input + , Table._in_init = init , Table._in_currency = _in_currency input , Table._in_incomes = incomes } @@ -65,3 +68,15 @@ view input = do return () return () + +reduceIncomes + :: forall t m. MonadWidget t m + => [Income] + -> Event t Income -- add income + -> Event t Income -- delete income + -> m (Dynamic t [Income]) +reduceIncomes initIncomes add delete = + R.foldDyn id initIncomes $ R.leftmost + [ (:) <$> add + , R.ffor delete (\p -> filter ((/= (_income_id p)) . _income_id)) + ] diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs index 358cb17..16ebf7c 100644 --- a/client/src/View/Income/Table.hs +++ b/client/src/View/Income/Table.hs @@ -4,29 +4,36 @@ module View.Income.Table , Out(..) ) where -import qualified Data.List as L -import qualified Data.Maybe as Maybe -import Data.Text (Text) -import Reflex.Dom (Dynamic, Event, MonadWidget) -import qualified Reflex.Dom as R +import qualified Data.List as L +import qualified Data.Maybe as Maybe +import Data.Text (Text) +import qualified Data.Text as T +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R -import Common.Model (Currency, Income (..), User (..)) -import qualified Common.Model as CM -import qualified Common.Msg as Msg -import qualified Common.View.Format as Format +import Common.Model (Currency, Income (..), User (..), + UserId) +import qualified Common.Model as CM +import qualified Common.Msg as Msg +import qualified Common.View.Format as Format -import qualified Component.Table as Table -import qualified View.Income.Add as Add -import View.Income.Init (Init (..)) +import qualified Component.ConfirmDialog as ConfirmDialog +import qualified Component.Table as Table +import qualified Util.Ajax as Ajax +import qualified Util.Either as EitherUtil +import qualified View.Income.Add as Add +import View.Income.Init (Init (..)) data In t = In - { _in_init :: Init - , _in_currency :: Currency - , _in_incomes :: Dynamic t [Income] + { _in_currentUser :: UserId + , _in_init :: Init + , _in_currency :: Currency + , _in_incomes :: Dynamic t [Income] } data Out t = Out - { _out_addIncome :: Event t Income + { _out_add :: Event t Income + , _out_delete :: Event t Income } view :: forall t m. MonadWidget t m => In t -> m (Out t) @@ -40,12 +47,23 @@ view input = do , Table._in_resetPage = R.never , Table._in_cloneModal = \income -> Add.view $ Add.In - { Add._in_income = Just <$> income + { Add._in_income = Just income } + , Table._in_deleteModal = \income -> + ConfirmDialog.view $ ConfirmDialog.In + { ConfirmDialog._in_header = Msg.get Msg.Income_DeleteConfirm + , ConfirmDialog._in_confirm = \e -> do + res <- Ajax.delete + (R.constDyn $ T.concat ["/api/income/", T.pack . show $ _income_id income]) + e + return $ income <$ R.fmapMaybe EitherUtil.eitherToMaybe res + } + , Table._in_isOwner = (== (_in_currentUser input)) . _income_userId } return $ Out - { _out_addIncome = Table._out_add table + { _out_add = Table._out_add table + , _out_delete = Table._out_delete table } data Header diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs index 471463c..e5e7219 100644 --- a/client/src/View/Payment/Delete.hs +++ b/client/src/View/Payment/Delete.hs @@ -12,7 +12,6 @@ import Common.Model (Payment (..)) import qualified Common.Msg as Msg import qualified Component.Button as Button import qualified Component.Modal as Modal -import qualified Component.Modal as Modal import qualified Util.Ajax as Ajax import qualified Util.Either as EitherUtil import qualified Util.WaitFor as WaitFor -- cgit v1.2.3