From 86957359ecf54c205aee1c09e151172c327e987a Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 31 Oct 2018 19:03:19 +0100 Subject: Various fixes --- client/src/Util/WaitFor.hs | 2 +- client/src/View/Payment/Add.hs | 115 ++++++++++++++++++++------------------- server/src/Controller/Index.hs | 3 +- server/src/Design/Global.hs | 14 +++-- server/src/Design/Helper.hs | 13 +---- server/src/Design/View/SignIn.hs | 6 -- 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 -- cgit v1.2.3