aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View/Payment')
-rw-r--r--client/src/View/Payment/Add.hs104
-rw-r--r--client/src/View/Payment/Delete.hs51
-rw-r--r--client/src/View/Payment/Header.hs33
-rw-r--r--client/src/View/Payment/Pages.hs2
-rw-r--r--client/src/View/Payment/Table.hs48
5 files changed, 209 insertions, 29 deletions
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
new file mode 100644
index 0000000..2eaec0f
--- /dev/null
+++ b/client/src/View/Payment/Add.hs
@@ -0,0 +1,104 @@
+module View.Payment.Add
+ ( view
+ , AddIn(..)
+ , AddOut(..)
+ ) where
+
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Map as M
+import qualified Data.Maybe as Maybe
+import qualified Data.Text as T
+import qualified Data.Time.Clock as Time
+import Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
+import qualified Text.Read as T
+
+import Common.Model (Category (..), CreatePayment (..),
+ Frequency (..))
+import qualified Common.Msg as Msg
+import qualified Common.Util.Time as Time
+import qualified Common.View.Format as Format
+import Component (ButtonIn (..), InputIn (..),
+ InputOut (..), SelectIn (..),
+ SelectOut (..))
+import qualified Component as Component
+import qualified Util.Ajax as Ajax
+import qualified Util.WaitFor as Util
+
+data AddIn = AddIn
+ { _addIn_categories :: [Category]
+ }
+
+data AddOut t = AddOut
+ { _addOut_cancel :: Event t ()
+ }
+
+view :: forall t m. MonadWidget t m => AddIn -> m (AddOut t)
+view addIn = do
+ R.divClass "add" $ do
+ R.divClass "addHeader" $ R.text $ Msg.get Msg.Payment_Add
+
+ R.divClass "addContent" $ do
+ name <- _inputOut_value <$> (Component.input $
+ Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+
+ cost <- _inputOut_value <$> (Component.input $
+ Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+
+ currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+
+ date <- _inputOut_value <$> (Component.input $
+ Component.defaultInputIn
+ { _inputIn_label = Msg.get Msg.Payment_Cost
+ , _inputIn_initialValue = Format.shortDay currentDay
+ })
+
+ frequency <- _selectOut_value <$> (Component.select $ SelectIn
+ { _selectIn_label = Msg.get Msg.Payment_Frequency
+ , _selectIn_initialValue = Punctual
+ , _selectIn_values = R.constDyn frequencies
+ })
+
+ category <- _selectOut_value <$> (Component.select $ SelectIn
+ { _selectIn_label = Msg.get Msg.Payment_Category
+ , _selectIn_initialValue = 0
+ , _selectIn_values = R.constDyn categories
+ })
+
+ let payment = CreatePayment
+ <$> name
+ <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
+ <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
+ <*> category
+ <*> frequency
+
+ cancel <- R.divClass "buttons" $ do
+ rec
+ validate <- 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
+ })
+
+ (_, waiting) <- Util.waitFor
+ (Ajax.post "/payment")
+ validate
+ payment
+
+ Component._buttonOut_clic <$> (Component.button $
+ (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+ { _buttonIn_class = R.constDyn "undo" })
+
+ return AddOut
+ { _addOut_cancel = cancel
+ }
+
+ where
+ frequencies = M.fromList
+ [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+ , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+ ]
+
+ categories = M.fromList . flip map (_addIn_categories addIn) $ \c ->
+ (_category_id c, _category_name c)
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
new file mode 100644
index 0000000..a1be16d
--- /dev/null
+++ b/client/src/View/Payment/Delete.hs
@@ -0,0 +1,51 @@
+module View.Payment.Delete
+ ( view
+ , DeleteIn(..)
+ , DeleteOut(..)
+ ) where
+
+import Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+import qualified Common.Msg as Msg
+import Component (ButtonIn (..), ButtonOut (..))
+import qualified Component as Component
+-- import qualified Util.Ajax as Ajax
+-- import qualified Util.WaitFor as Util
+
+data DeleteIn = DeleteIn
+ {}
+
+data DeleteOut t = DeleteOut
+ { _deleteOut_cancel :: Event t ()
+ }
+
+view :: forall t m. MonadWidget t m => DeleteIn -> m (DeleteOut t)
+view _ =
+ R.divClass "delete" $ do
+ R.divClass "deleteHeader" $ R.text $ Msg.get Msg.Payment_DeleteConfirm
+
+ R.divClass "deleteContent" $ do
+
+ cancel <- R.divClass "buttons" $ do
+ rec
+ _ <- Component._buttonOut_clic <$> (Component.button $
+ (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
+ { _buttonIn_class = R.constDyn "confirm"
+ , _buttonIn_submit = True
+ })
+
+ -- (_, waiting) <- Util.waitFor
+ -- (Ajax.post "/payment")
+ -- validate
+ -- payment
+
+ cancel <- Component._buttonOut_clic <$> (Component.button $
+ (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+ { _buttonIn_class = R.constDyn "undo" })
+
+ return cancel
+
+ return DeleteOut
+ { _deleteOut_cancel = cancel
+ }
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index a694136..d01dec6 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -16,9 +16,10 @@ import Prelude hiding (init)
import Reflex.Dom (Dynamic, MonadWidget, Reflex)
import qualified Reflex.Dom as R
-import Common.Model (Currency, ExceedingPayer (..),
- Frequency (..), Income (..), Init (..),
- Payment (..), User (..))
+import Common.Model (Category, Currency,
+ ExceedingPayer (..), Frequency (..),
+ Income (..), Init (..), Payment (..),
+ User (..))
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.Util.Text as T
@@ -26,9 +27,11 @@ import qualified Common.View.Format as Format
import Component (ButtonIn (..), ButtonOut (..),
InputIn (..), InputOut (..),
- ModalIn (..))
+ ModalIn (..), ModalOut (..))
import qualified Component as Component
import qualified Util.List as L
+import View.Payment.Add (AddIn (..), AddOut (..))
+import qualified View.Payment.Add as Add
data HeaderIn t = HeaderIn
{ _headerIn_init :: Init
@@ -42,7 +45,7 @@ data HeaderOut t = HeaderOut
widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
widget headerIn =
R.divClass "header" $ do
- payerAndAdd incomes punctualPayments users currency
+ payerAndAdd incomes punctualPayments users categories currency
(searchName, searchFrequency) <- searchLine
let searchPayments = getSearchPayments searchName searchFrequency payments
infos searchPayments users currency
@@ -56,6 +59,7 @@ widget headerIn =
payments = _init_payments init
punctualPayments = filter ((==) Punctual . _payment_frequency) payments
users = _init_users init
+ categories = _init_categories init
currency = _init_currency init
getSearchPayments :: forall t. (Reflex t) => Dynamic t Text -> Dynamic t Frequency -> [Payment] -> Dynamic t [Payment]
@@ -63,12 +67,12 @@ getSearchPayments name frequency payments = do
n <- name
f <- frequency
pure $ flip filter payments (\p ->
- ( T.search n (_payment_name p)
+ ( (T.search n (_payment_name p) || T.search n (T.pack . show . _payment_cost $ p))
&& (_payment_frequency p == f)
))
-payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> Currency -> m ()
-payerAndAdd incomes payments users currency = do
+payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> [Category] -> Currency -> m ()
+payerAndAdd incomes payments users categories currency = do
time <- liftIO Time.getCurrentTime
R.divClass "payerAndAdd" $ do
R.divClass "exceedingPayers" $
@@ -86,11 +90,15 @@ payerAndAdd incomes payments users currency = do
{ _buttonIn_class = R.constDyn "addPayment"
, _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
, _buttonIn_waiting = R.never
+ , _buttonIn_tabIndex = Nothing
+ , _buttonIn_submit = False
})
- _ <- Component.modal $ ModalIn
- { _modalIn_show = addPayment
- , _modalIn_content = R.el "h1" $ R.text "Ajouter un paiement"
- }
+ rec
+ modalOut <- Component.modal $ ModalIn
+ { _modalIn_show = addPayment
+ , _modalIn_hide = _addOut_cancel . _modalOut_content $ modalOut
+ , _modalIn_content = Add.view $ AddIn { _addIn_categories = categories }
+ }
return ()
searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text, Dynamic t Frequency)
@@ -99,6 +107,7 @@ searchLine = do
searchName <- _inputOut_value <$> (Component.input $ InputIn
{ _inputIn_reset = R.never
, _inputIn_label = Msg.get Msg.Search_Name
+ , _inputIn_initialValue = ""
})
let frequencies = M.fromList
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 55ceb9f..d14b640 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -82,5 +82,7 @@ pageButton currentPage page content = do
if cp == Just p then "page current" else "page"
, _buttonIn_content = content
, _buttonIn_waiting = R.never
+ , _buttonIn_tabIndex = Nothing
+ , _buttonIn_submit = False
})
return . fmap fst $ R.attach (R.current page) clic
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index a49be5c..23d7225 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -4,23 +4,28 @@ module View.Payment.Table
, TableOut(..)
) where
-import qualified Data.List as L
-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 qualified Reflex.Dom as R
-
-import Common.Model (Category (..), Init (..), Payment (..),
- PaymentCategory (..), User (..))
-import qualified Common.Model as CM
-import qualified Common.Msg as Msg
-import qualified Common.Util.Text as T
-import qualified Common.View.Format as Format
+import qualified Data.List as L
+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 qualified Reflex.Dom as R
+
+import Common.Model (Category (..), Init (..), Payment (..),
+ PaymentCategory (..), User (..))
+import qualified Common.Model as CM
+import qualified Common.Msg as Msg
+import qualified Common.Util.Text as T
+import qualified Common.View.Format as Format
+import Component (ButtonIn (..), ButtonOut (..),
+ ModalIn (..), ModalOut (..))
+import qualified Component as Component
+import View.Payment.Delete (DeleteIn (..), DeleteOut (..))
+import qualified View.Payment.Delete as Delete
import qualified Icon
-import qualified Util.Dom as Dom
+import qualified Util.Dom as Dom
data TableIn t = TableIn
{ _tableIn_init :: Init
@@ -105,8 +110,17 @@ paymentRow init payment =
M.fromList [("class", "cell button"), ("display", if _payment_user p == _init_currentUser init then "block" else "none")]
R.elDynAttr "div" modifyAttrs $
R.el "button" $ Icon.edit
- R.elDynAttr "div" modifyAttrs $
- R.el "button" $ Icon.delete
+ deletePayment <- R.elDynAttr "div" modifyAttrs $
+ _buttonOut_clic <$> (Component.button $
+ (Component.defaultButtonIn Icon.delete)
+ { _buttonIn_class = R.constDyn "deletePayment" })
+ rec
+ modalOut <- Component.modal $ ModalIn
+ { _modalIn_show = deletePayment
+ , _modalIn_hide = _deleteOut_cancel . _modalOut_content $ modalOut
+ , _modalIn_content = Delete.view (DeleteIn {})
+ }
+ return ()
findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
findCategory categories paymentCategories paymentName = do
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 05:46:16 +0000