diff options
author | Joris | 2018-10-30 18:04:58 +0100 |
---|---|---|
committer | Joris | 2018-10-30 18:04:58 +0100 |
commit | 50fb8fa48d1c4881da20b4ecf6d68a772301e713 (patch) | |
tree | 99c30c644d40664a9a7bb4a27e838d7cccda7a5f /client/src/View/Payment/Table.hs | |
parent | 40b4994797a797b1fa86cafda789a5c488730c6d (diff) |
Update table when adding or removing a payment
Diffstat (limited to 'client/src/View/Payment/Table.hs')
-rw-r--r-- | client/src/View/Payment/Table.hs | 29 |
1 files changed, 17 insertions, 12 deletions
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs index 13cedda..ba16bf5 100644 --- a/client/src/View/Payment/Table.hs +++ b/client/src/View/Payment/Table.hs @@ -9,11 +9,12 @@ import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import Prelude hiding (init) -import Reflex.Dom (Dynamic, MonadWidget) +import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R import Common.Model (Category (..), Init (..), Payment (..), - PaymentCategory (..), User (..)) + PaymentCategory (..), PaymentId, + User (..)) import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Common.Util.Text as T @@ -34,15 +35,15 @@ data TableIn t = TableIn , _tableIn_perPage :: Int } -data TableOut = TableOut - { +data TableOut t = TableOut + { _tableOut_deletedPayment :: Event t PaymentId } -widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut +widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t) widget tableIn = do R.divClass "table" $ do - R.divClass "lines" $ do + deletedPayment <- R.divClass "lines" $ do R.divClass "header" $ do R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name R.divClass "cell cost" $ R.text $ Msg.get Msg.Payment_Cost @@ -52,13 +53,14 @@ widget tableIn = do R.divClass "cell" $ R.blank R.divClass "cell" $ R.blank R.divClass "cell" $ R.blank - _ <- R.simpleList paymentRange (paymentRow init) - return () + (R.switch . R.current . fmap R.leftmost) <$> (R.simpleList paymentRange (paymentRow init)) Dom.divClassVisibleIf (null <$> payments) "emptyTableMsg" $ R.text $ Msg.get Msg.Payment_Empty - return $ TableOut {} + return $ TableOut + { _tableOut_deletedPayment = deletedPayment + } where init = _tableIn_init tableIn @@ -74,7 +76,7 @@ getPaymentRange perPage payments currentPage = . L.sortOn _payment_date $ payments -paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m () +paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m (Event t PaymentId) paymentRow init payment = R.divClass "row" $ do R.divClass "cell name" . R.dynText . fmap _payment_name $ payment @@ -117,10 +119,13 @@ paymentRow init payment = rec modalOut <- Component.modal $ ModalIn { _modalIn_show = deletePayment - , _modalIn_hide = _deleteOut_cancel . _modalOut_content $ modalOut + , _modalIn_hide = R.leftmost $ + [ _deleteOut_cancel . _modalOut_content $ modalOut + , fmap (const ()) . _deleteOut_validate . _modalOut_content $ modalOut + ] , _modalIn_content = Delete.view (DeleteIn { _deleteIn_id = fmap _payment_id payment }) } - return () + return (_deleteOut_validate . _modalOut_content $ modalOut) findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category findCategory categories paymentCategories paymentName = do |