aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/App.hs3
-rw-r--r--client/src/View/Payment.hs2
-rw-r--r--client/src/View/Payment/Add.hs127
-rw-r--r--client/src/View/Payment/Header.hs16
-rw-r--r--client/src/View/Payment/Pages.hs2
-rw-r--r--client/src/View/SignIn.hs48
6 files changed, 124 insertions, 74 deletions
diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index 9aa6c57..6435297 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -16,7 +16,8 @@ import qualified View.SignIn as SignIn
widget :: InitResult -> IO ()
widget initResult =
- R.mainWidget $ do
+ R.mainWidget $ R.divClass "app" $ do
+
headerOut <- Header.view $ HeaderIn
{ _headerIn_initResult = initResult
}
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 5245e72..007471d 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -30,7 +30,7 @@ data PaymentOut = PaymentOut
widget :: forall t m. MonadWidget t m => PaymentIn -> m PaymentOut
widget paymentIn = do
- R.divClass "payment" $ do
+ R.elClass "main" "payment" $ do
rec
let init = _paymentIn_init paymentIn
paymentsPerPage = 7
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 061eeeb..62b26a3 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -4,31 +4,34 @@ module View.Payment.Add
, 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.Calendar as Calendar
-import qualified Data.Time.Clock as Time
-import Reflex.Dom (Event, MonadWidget, Reflex)
-import qualified Reflex.Dom as R
-import qualified Text.Read as T
-
-import Common.Model (Category (..), CreatePayment (..),
- Frequency (..), Payment (..))
-import qualified Common.Msg as Msg
-import qualified Common.Util.Time as Time
-import Component (ButtonIn (..), InputIn (..),
- InputOut (..), SelectIn (..),
- SelectOut (..))
-import qualified Component as Component
-import qualified Util.Ajax as Ajax
-import qualified Util.Either as EitherUtil
-import qualified Util.WaitFor as WaitFor
+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.Calendar as Calendar
+import qualified Data.Time.Clock as Time
+import qualified Data.Validation as V
+import Reflex.Dom (Event, MonadWidget, Reflex)
+import qualified Reflex.Dom as R
+import qualified Text.Read as T
+
+import Common.Model (Category (..), CreatePayment (..),
+ Frequency (..), Payment (..))
+import qualified Common.Msg as Msg
+import qualified Common.Util.Time as Time
+import qualified Common.Validation.Payment as PaymentValidation
+import Component (ButtonIn (..), InputIn (..),
+ InputOut (..), SelectIn (..),
+ SelectOut (..))
+import qualified Component as Component
+import qualified Util.Ajax as Ajax
+import qualified Util.Either as EitherUtil
+import qualified Util.Validation as ValidationUtil
+import qualified Util.WaitFor as WaitFor
data AddIn t = AddIn
{ _addIn_categories :: [Category]
- , _addIn_show :: Event t ()
+ , _addIn_cancel :: Event t ()
}
data AddOut t = AddOut
@@ -43,48 +46,84 @@ view addIn = do
R.divClass "addContent" $ do
rec
+ let reset = R.leftmost
+ [ const "" <$> cancel
+ , const "" <$> addedPayment
+ , const "" <$> _addIn_cancel addIn
+ ]
+
name <- _inputOut_value <$> (Component.input
- (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
- (const () <$ addedPayment))
+ (Component.defaultInputIn
+ { _inputIn_label = Msg.get Msg.Payment_Name
+ , _inputIn_validation = PaymentValidation.name
+ })
+ reset
+ validate)
cost <- _inputOut_value <$> (Component.input
- (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
- (const () <$ addedPayment))
+ (Component.defaultInputIn
+ { _inputIn_label = Msg.get Msg.Payment_Cost
+ , _inputIn_validation = PaymentValidation.cost
+ })
+ reset
+ validate)
- currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+ currentDay <- do
+ d <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+ return . T.pack . Calendar.showGregorian $ d
date <- _inputOut_value <$> (Component.input
(Component.defaultInputIn
{ _inputIn_label = Msg.get Msg.Payment_Date
- , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
+ , _inputIn_initialValue = currentDay
, _inputIn_inputType = "date"
, _inputIn_hasResetButton = False
+ , _inputIn_validation = PaymentValidation.date
})
- (const () <$ addedPayment))
+ (const currentDay <$> reset)
+ validate)
frequency <- _selectOut_value <$> (Component.select $ SelectIn
{ _selectIn_label = Msg.get Msg.Payment_Frequency
, _selectIn_initialValue = Punctual
, _selectIn_values = R.constDyn frequencies
- , _selectIn_reset = _addIn_show addIn
+ , _selectIn_reset = reset
+ , _selectIn_isValid = const True
+ , _selectIn_validate = validate
})
category <- _selectOut_value <$> (Component.select $ SelectIn
{ _selectIn_label = Msg.get Msg.Payment_Category
- , _selectIn_initialValue = 0
+ , _selectIn_initialValue = -1
, _selectIn_values = R.constDyn categories
- , _selectIn_reset = _addIn_show addIn
+ , _selectIn_reset = reset
+ , _selectIn_isValid = \id -> id /= -1
+ , _selectIn_validate = validate
})
- let payment = CreatePayment
- <$> name
- <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
- <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
- <*> category
- <*> frequency
-
- (addedPayment, cancel) <- R.divClass "buttons" $ do
+ let payment = do
+ n <- name
+ c <- cost
+ d <- date
+ cat <- category
+ f <- frequency
+ pure $ do
+ n' <- n
+ c' <- c
+ d' <- d
+ pure $ CreatePayment
+ <$> ValidationUtil.nelError n'
+ <*> ValidationUtil.nelError c'
+ <*> ValidationUtil.nelError d'
+ <*> ValidationUtil.nelError (V.Success cat)
+ <*> ValidationUtil.nelError (V.Success f)
+
+ (addedPayment, cancel, validate) <- R.divClass "buttons" $ do
rec
+ cancel <- Component._buttonOut_clic <$> (Component.button $
+ (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+ { _buttonIn_class = R.constDyn "undo" })
+
validate <- Component._buttonOut_clic <$> (Component.button $
(Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
{ _buttonIn_class = R.constDyn "confirm"
@@ -94,13 +133,9 @@ view addIn = do
(result, waiting) <- WaitFor.waitFor
(Ajax.postJson "/payment")
- (R.tag (R.current payment) validate)
-
- cancel <- Component._buttonOut_clic <$> (Component.button $
- (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
- { _buttonIn_class = R.constDyn "undo" })
+ (ValidationUtil.fireValidation payment validate)
- return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
+ return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel, validate)
return AddOut
{ _addOut_cancel = cancel
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 6fbaecf..56441eb 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -97,18 +97,19 @@ payerAndAdd incomes payments users categories currency = do
, _buttonIn_submit = False
})
rec
- modalOut <- fmap _modalOut_content . Component.modal $ ModalIn
+ modalOut <- Component.modal $ ModalIn
{ _modalIn_show = addPaymentClic
, _modalIn_hide = R.leftmost $
- [ _addOut_cancel modalOut
- , fmap (const ()) . _addOut_addedPayment $ modalOut
+ [ _addOut_cancel addOut
+ , fmap (const ()) . _addOut_addedPayment $ addOut
]
, _modalIn_content = Add.view $ AddIn
{ _addIn_categories = categories
- , _addIn_show = addPaymentClic
+ , _addIn_cancel = _modalOut_hide modalOut
}
}
- return (_addOut_addedPayment modalOut)
+ let addOut = _modalOut_content modalOut
+ return (_addOut_addedPayment addOut)
searchLine
:: forall t m. MonadWidget t m
@@ -116,9 +117,10 @@ searchLine
-> m (Dynamic t Text, Dynamic t Frequency)
searchLine reset = do
R.divClass "searchLine" $ do
- searchName <- _inputOut_value <$> (Component.input
+ searchName <- _inputOut_raw <$> (Component.input
( Component.defaultInputIn { _inputIn_label = Msg.get Msg.Search_Name })
- reset)
+ (const "" <$> reset)
+ R.never)
let frequencies = M.fromList
[ (Punctual, Msg.get Msg.Payment_PunctualMale)
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 57d67ac..cbe7b50 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -47,7 +47,7 @@ pageButtons total perPage reset = do
, pageClic
, nextPageClic
, lastPageClic
- , (const 1) <$> reset
+ , 1 <$ reset
]
firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index 428997e..6fbf6d6 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -3,20 +3,24 @@ module View.SignIn
, view
) where
-import qualified Data.Either as Either
-import Data.Text (Text)
-import Prelude hiding (error)
-import Reflex.Dom (Event, MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.Either as Either
+import qualified Data.Maybe as Maybe
+import Data.Text (Text)
+import Data.Validation (Validation)
+import Prelude hiding (error)
+import Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
-import Common.Model (SignIn (SignIn))
-import qualified Common.Msg as Msg
+import Common.Model (SignInForm (SignInForm))
+import qualified Common.Msg as Msg
+import qualified Common.Validation.SignIn as SignInValidation
-import Component (ButtonIn (..), ButtonOut (..), InputIn (..),
- InputOut (..))
-import qualified Component as Component
-import qualified Util.Ajax as Ajax
-import qualified Util.WaitFor as WaitFor
+import Component (ButtonIn (..), ButtonOut (..),
+ InputIn (..), InputOut (..))
+import qualified Component as Component
+import qualified Util.Ajax as Ajax
+import qualified Util.Validation as ValidationUtil
+import qualified Util.WaitFor as WaitFor
data SignInMessage =
SuccessMessage Text
@@ -29,19 +33,27 @@ view signInMessage =
Component.form $ do
rec
input <- (Component.input
- (Component.defaultInputIn { _inputIn_label = Msg.get Msg.SignIn_EmailLabel })
- (R.ffilter Either.isRight signInResult))
+ (Component.defaultInputIn
+ { _inputIn_label = Msg.get Msg.SignIn_EmailLabel
+ , _inputIn_validation = SignInValidation.email
+ })
+ (const "" <$> R.ffilter Either.isRight signInResult)
+ validate)
- button <- Component.button $
+ validate <- _buttonOut_clic <$> (Component.button $
(Component.defaultButtonIn (R.text $ Msg.get Msg.SignIn_Button))
{ _buttonIn_class = R.constDyn "validate"
, _buttonIn_waiting = waiting
, _buttonIn_submit = True
- }
+ })
+
+ let form = SignInForm <$> _inputOut_raw input
(signInResult, waiting) <- WaitFor.waitFor
- (\email -> Ajax.postJson "/askSignIn" (SignIn <$> email))
- (R.tag (R.current (_inputOut_value input)) (_buttonOut_clic button))
+ (Ajax.postJson "/askSignIn")
+ (ValidationUtil.fireMaybe
+ ((\f -> const f <$> SignInValidation.signIn f) <$> form)
+ validate)
showSignInResult signInMessage signInResult
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-03 21:21:04 +0000