diff options
Diffstat (limited to 'client/src/View/Payment/Table.hs')
| -rw-r--r-- | client/src/View/Payment/Table.hs | 109 |
1 files changed, 79 insertions, 30 deletions
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs index b09f30f..f2b8870 100644 --- a/client/src/View/Payment/Table.hs +++ b/client/src/View/Payment/Table.hs @@ -6,25 +6,32 @@ module View.Payment.Table import qualified Data.List as L import qualified Data.Map as M +import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T import Prelude hiding (init) import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Category (..), Init (..), Payment (..), - PaymentCategory (..), User (..)) +import Common.Model (Category (..), Frequency (Punctual), + Init (..), Payment (..), + PaymentCategory (..), SavedPayment, + User (..)) import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Common.View.Format as Format -import Component (ButtonIn (..), ButtonOut (..), - ModalIn (..), ModalOut (..)) +import Component (ButtonIn (..), ButtonOut (..)) import qualified Component as Component -import View.Payment.Delete (DeleteIn (..), DeleteOut (..)) +import qualified Component.Modal as Modal +import qualified View.Payment.Clone as Clone import qualified View.Payment.Delete as Delete +import qualified View.Payment.Edit as Edit import qualified Icon -import qualified Util.Dom as DomUtil +import qualified Util.Reflex as ReflexUtil + +-- TODO: remove +import Debug.Trace (trace) data TableIn t = TableIn { _tableIn_init :: Init @@ -32,17 +39,19 @@ data TableIn t = TableIn , _tableIn_payments :: Dynamic t [Payment] , _tableIn_perPage :: Int , _tableIn_paymentCategories :: Dynamic t [PaymentCategory] + , _tableIn_categories :: [Category] } data TableOut t = TableOut - { _tableOut_deletePayment :: Event t Payment + { _tableOut_addPayment :: Event t SavedPayment + , _tableOut_deletePayment :: Event t Payment } widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t) widget tableIn = do R.divClass "table" $ do - deletePayment <- R.divClass "lines" $ do + (addPayment, deletePayment) <- 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,14 +61,21 @@ widget tableIn = do R.divClass "cell" $ R.blank R.divClass "cell" $ R.blank R.divClass "cell" $ R.blank - (R.switch . R.current . fmap R.leftmost) <$> + + result <- (R.simpleList paymentRange (paymentRow init paymentCategories)) - DomUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $ + return $ + ( R.switch . R.current . fmap (R.leftmost . map fst) $ result + , R.switch . R.current . fmap (R.leftmost . map snd) $ result + ) + + ReflexUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $ R.text $ Msg.get Msg.Payment_Empty return $ TableOut - { _tableOut_deletePayment = deletePayment + { _tableOut_addPayment = addPayment + , _tableOut_deletePayment = deletePayment } where @@ -82,7 +98,7 @@ paymentRow => Init -> Dynamic t [PaymentCategory] -> Dynamic t Payment - -> m (Event t Payment) + -> m (Event t SavedPayment, Event t Payment) paymentRow init paymentCategories payment = R.divClass "row" $ do @@ -115,7 +131,7 @@ paymentRow init paymentCategories payment = Nothing -> M.singleton "display" "none" R.elDynAttr "span" attrs $ - R.dynText $ flip fmap category $ \mbCategory -> case mbCategory of + R.dynText $ R.ffor category $ \case Just c -> _category_name c _ -> "" @@ -123,35 +139,68 @@ paymentRow init paymentCategories payment = R.elClass "span" "shortDate" . R.dynText . fmap (Format.shortDay . _payment_date) $ payment R.elClass "span" "longDate" . R.dynText . fmap (Format.longDay . _payment_date) $ payment - R.divClass "cell button" $ - R.el "button" Icon.clone + let categoryId = (Maybe.fromMaybe (-1) . fmap _category_id) <$> category + + clonePayment <- + R.divClass "cell button" $ + _buttonOut_clic <$> (Component.button $ + Component.defaultButtonIn Icon.clone) + + paymentCloned <- + Modal.view $ Modal.Input + { Modal._input_show = clonePayment + , Modal._input_content = + Clone.view $ Clone.Input + { Clone._input_show = clonePayment + , Clone._input_categories = _init_categories init + , Clone._input_paymentCategories = paymentCategories + , Clone._input_payment = payment + , Clone._input_category = categoryId + } + } let isFromCurrentUser = R.ffor payment (\p -> _payment_user p == _init_currentUser init) - R.divClass "cell button" $ - DomUtil.divVisibleIf isFromCurrentUser $ - R.el "button" Icon.edit + editPayment <- + R.divClass "cell button" $ + ReflexUtil.divVisibleIf isFromCurrentUser $ + _buttonOut_clic <$> (Component.button $ + Component.defaultButtonIn Icon.edit) + + paymentEdited <- + Modal.view $ Modal.Input + { Modal._input_show = editPayment + , Modal._input_content = + Edit.view $ Edit.Input + { Edit._input_show = editPayment + , Edit._input_categories = _init_categories init + , Edit._input_paymentCategories = paymentCategories + , Edit._input_payment = payment + , Edit._input_category = categoryId + } + } deletePayment <- R.divClass "cell button" $ - DomUtil.divVisibleIf isFromCurrentUser $ + ReflexUtil.divVisibleIf isFromCurrentUser $ _buttonOut_clic <$> (Component.button $ (Component.defaultButtonIn Icon.delete) - { _buttonIn_class = R.constDyn "deletePayment" }) - - rec - modalOut <- Component.modal $ ModalIn - { _modalIn_show = deletePayment - , _modalIn_hide = R.leftmost $ - [ _deleteOut_cancel . _modalOut_content $ modalOut - , fmap (const ()) . _deleteOut_validate . _modalOut_content $ modalOut - ] - , _modalIn_content = Delete.view (DeleteIn { _deleteIn_payment = payment }) + { _buttonIn_class = R.constDyn "deletePayment" + }) + + paymentDeleted <- + Modal.view $ Modal.Input + { Modal._input_show = deletePayment + , Modal._input_content = + Delete.view $ Delete.Input + { Delete._input_payment = payment + } } - return (_deleteOut_validate . _modalOut_content $ modalOut) + + return $ (paymentCloned, paymentDeleted) findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category findCategory categories paymentCategories paymentName = do |