aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--client/src/Util/WaitFor.hs2
-rw-r--r--client/src/View/Payment/Add.hs115
-rw-r--r--server/src/Controller/Index.hs3
-rw-r--r--server/src/Design/Global.hs14
-rw-r--r--server/src/Design/Helper.hs13
-rw-r--r--server/src/Design/View/SignIn.hs6
6 files changed, 72 insertions, 81 deletions
diff --git a/client/src/Util/WaitFor.hs b/client/src/Util/WaitFor.hs
index 46882aa..02edff5 100644
--- a/client/src/Util/WaitFor.hs
+++ b/client/src/Util/WaitFor.hs
@@ -12,6 +12,6 @@ waitFor
-> Event t a
-> m (Event t b, Event t Bool)
waitFor op input = do
- result <- op input >>= R.debounce (0.2 :: NominalDiffTime)
+ result <- op input >>= R.debounce (0.5 :: NominalDiffTime)
let waiting = R.leftmost [ const True <$> input , const False <$> result ]
return (result, waiting)
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 1864e76..061eeeb 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -42,64 +42,65 @@ view addIn = 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 })
- (_addIn_show addIn))
-
- cost <- _inputOut_value <$> (Component.input
- (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
- (_addIn_show addIn))
-
- currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
-
- date <- _inputOut_value <$> (Component.input
- (Component.defaultInputIn
- { _inputIn_label = Msg.get Msg.Payment_Date
- , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
- , _inputIn_inputType = "date"
- , _inputIn_hasResetButton = False
+ rec
+ name <- _inputOut_value <$> (Component.input
+ (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+ (const () <$ addedPayment))
+
+ cost <- _inputOut_value <$> (Component.input
+ (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+ (const () <$ addedPayment))
+
+ currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+
+ date <- _inputOut_value <$> (Component.input
+ (Component.defaultInputIn
+ { _inputIn_label = Msg.get Msg.Payment_Date
+ , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
+ , _inputIn_inputType = "date"
+ , _inputIn_hasResetButton = False
+ })
+ (const () <$ addedPayment))
+
+ 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
})
- (_addIn_show addIn))
-
- 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
- })
-
- category <- _selectOut_value <$> (Component.select $ SelectIn
- { _selectIn_label = Msg.get Msg.Payment_Category
- , _selectIn_initialValue = 0
- , _selectIn_values = R.constDyn categories
- , _selectIn_reset = _addIn_show addIn
- })
-
- 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
- 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
- })
-
- (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" })
-
- return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
+
+ category <- _selectOut_value <$> (Component.select $ SelectIn
+ { _selectIn_label = Msg.get Msg.Payment_Category
+ , _selectIn_initialValue = 0
+ , _selectIn_values = R.constDyn categories
+ , _selectIn_reset = _addIn_show addIn
+ })
+
+ 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
+ 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
+ })
+
+ (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" })
+
+ return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
return AddOut
{ _addOut_cancel = cancel
diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs
index f942540..0b276d3 100644
--- a/server/src/Controller/Index.hs
+++ b/server/src/Controller/Index.hs
@@ -6,6 +6,7 @@ module Controller.Index
) where
import Control.Monad.IO.Class (liftIO)
+import qualified Data.Aeson as Json
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@@ -60,7 +61,7 @@ askSignIn conf (SignIn email) =
]
maybeSentMail <- liftIO . SendMail.sendMail conf $ SignIn.mail conf user url [email]
case maybeSentMail of
- Right _ -> textKey ok200 Msg.SignIn_EmailSent
+ Right _ -> S.json (Json.String . Msg.get $ Msg.SignIn_EmailSent)
Left _ -> textKey badRequest400 Msg.SignIn_EmailSendFail
Nothing -> textKey badRequest400 Msg.Secure_Unauthorized
else textKey badRequest400 Msg.SignIn_EmailInvalid
diff --git a/server/src/Design/Global.hs b/server/src/Design/Global.hs
index de8dd61..ba4ccb7 100644
--- a/server/src/Design/Global.hs
+++ b/server/src/Design/Global.hs
@@ -73,14 +73,20 @@ global = do
svg ? height (pct 100)
button ? do
- ".content" ? display flex
- svg # ".loader" ? display none
+ position relative
+
+ ".content" ? do
+ display flex
+
+ svg # ".loader" ? do
+ opacity 0
+ position absolute
".waiting" & do
".content" ? do
- display none
+ opacity 0
svg # ".loader" ? do
- display block
+ opacity 1
rotateKeyframes
rotateAnimation
diff --git a/server/src/Design/Helper.hs b/server/src/Design/Helper.hs
index 6980c71..e586d56 100644
--- a/server/src/Design/Helper.hs
+++ b/server/src/Design/Helper.hs
@@ -1,16 +1,14 @@
module Design.Helper
( clearFix
, button
- , input
, centeredWithMargin
, verticalCentering
) where
import Prelude hiding (span)
-import Clay hiding (button, input)
+import Clay hiding (button)
-import Design.Color as Color
import Design.Constants
clearFix :: Css
@@ -37,15 +35,6 @@ button backgroundCol textCol h focusOp = do
hover & backgroundColor (focusOp backgroundCol)
focus & backgroundColor (focusOp backgroundCol)
-input :: Double -> Css
-input h = do
- height (px h)
- padding (px 10) (px 10) (px 10) (px 10)
- borderRadius radius radius radius radius
- border solid (px 1) Color.dustyGray
- focus & borderColor Color.silver
- verticalAlign middle
-
centeredWithMargin :: Css
centeredWithMargin = do
width (pct blockPercentWidth)
diff --git a/server/src/Design/View/SignIn.hs b/server/src/Design/View/SignIn.hs
index 7f5f503..2138676 100644
--- a/server/src/Design/View/SignIn.hs
+++ b/server/src/Design/View/SignIn.hs
@@ -17,12 +17,6 @@ design = do
marginLeft auto
marginRight auto
- input ? do
- Helper.input inputHeight
- display block
- width (pct 100)
- marginBottom (px 10)
-
button # ".validate" ? do
Helper.button Color.gothic Color.white (px inputHeight) Constants.focusLighten
display flex
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 09:55:28 +0000