From 80f09e8b3a5c856e60922a73c9161a8c5392e4d4 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 22 Oct 2019 21:35:03 +0200 Subject: Create ModalForm component --- client/src/Component/ModalForm.hs | 70 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100644 client/src/Component/ModalForm.hs (limited to 'client/src/Component/ModalForm.hs') diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs new file mode 100644 index 0000000..63cb1d2 --- /dev/null +++ b/client/src/Component/ModalForm.hs @@ -0,0 +1,70 @@ +module Component.ModalForm + ( modalForm + , ModalFormIn(..) + , ModalFormOut(..) + ) where + +import Data.Aeson (ToJSON) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as V +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R + +import qualified Common.Msg as Msg +import Component.Button (ButtonIn (..)) +import qualified Component.Button as Button +import qualified Util.Either as EitherUtil +import qualified Util.Validation as ValidationUtil +import qualified Util.WaitFor as WaitFor + +data ModalFormIn m t a b e = ModalFormIn + { _modalFormIn_headerLabel :: Text + , _modalFormIn_form :: m (Dynamic t (Validation e a)) + , _modalFormIn_ajax :: Event t a -> m (Event t (Either Text b)) + } + +data ModalFormOut t a = ModalFormOut + { _modalFormOut_hide :: Event t () + , _modalFormOut_cancel :: Event t () + , _modalFormOut_confirm :: Event t () + , _modalFormOut_validate :: Event t a + } + +modalForm :: forall t m a b e. (MonadWidget t m, ToJSON a) => ModalFormIn m t a b e -> m (ModalFormOut t b) +modalForm modalFormIn = + R.divClass "form" $ do + R.divClass "formHeader" $ + R.text (_modalFormIn_headerLabel modalFormIn) + + R.divClass "formContent" $ do + rec + form <- _modalFormIn_form modalFormIn + + (validate, cancel, confirm) <- R.divClass "buttons" $ do + rec + cancel <- Button._buttonOut_clic <$> (Button.button $ + (Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo)) + { _buttonIn_class = R.constDyn "undo" }) + + confirm <- Button._buttonOut_clic <$> (Button.button $ + (Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm)) + { _buttonIn_class = R.constDyn "confirm" + , _buttonIn_waiting = waiting + , _buttonIn_submit = True + }) + + (validate, waiting) <- WaitFor.waitFor + (_modalFormIn_ajax modalFormIn) + (ValidationUtil.fireValidation form confirm) + + return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm) + + return ModalFormOut + { _modalFormOut_hide = R.leftmost [ cancel, () <$ validate ] + , _modalFormOut_cancel = cancel + , _modalFormOut_confirm = confirm + , _modalFormOut_validate = validate + } -- cgit v1.2.3 From 613ffccac4b3ab25c6d4c631fab757da0b35acf6 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 22 Oct 2019 22:26:38 +0200 Subject: Harmonize view component code style --- client/src/Component/ModalForm.hs | 61 +++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 31 deletions(-) (limited to 'client/src/Component/ModalForm.hs') diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs index 63cb1d2..ea53beb 100644 --- a/client/src/Component/ModalForm.hs +++ b/client/src/Component/ModalForm.hs @@ -1,7 +1,7 @@ module Component.ModalForm - ( modalForm - , ModalFormIn(..) - , ModalFormOut(..) + ( view + , In(..) + , Out(..) ) where import Data.Aeson (ToJSON) @@ -14,57 +14,56 @@ import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R import qualified Common.Msg as Msg -import Component.Button (ButtonIn (..)) import qualified Component.Button as Button import qualified Util.Either as EitherUtil import qualified Util.Validation as ValidationUtil import qualified Util.WaitFor as WaitFor -data ModalFormIn m t a b e = ModalFormIn - { _modalFormIn_headerLabel :: Text - , _modalFormIn_form :: m (Dynamic t (Validation e a)) - , _modalFormIn_ajax :: Event t a -> m (Event t (Either Text b)) +data In m t a b e = In + { _in_headerLabel :: Text + , _in_form :: m (Dynamic t (Validation e a)) + , _in_ajax :: Event t a -> m (Event t (Either Text b)) } -data ModalFormOut t a = ModalFormOut - { _modalFormOut_hide :: Event t () - , _modalFormOut_cancel :: Event t () - , _modalFormOut_confirm :: Event t () - , _modalFormOut_validate :: Event t a +data Out t a = Out + { _out_hide :: Event t () + , _out_cancel :: Event t () + , _out_confirm :: Event t () + , _out_validate :: Event t a } -modalForm :: forall t m a b e. (MonadWidget t m, ToJSON a) => ModalFormIn m t a b e -> m (ModalFormOut t b) -modalForm modalFormIn = +view :: forall t m a b e. (MonadWidget t m, ToJSON a) => In m t a b e -> m (Out t b) +view input = R.divClass "form" $ do R.divClass "formHeader" $ - R.text (_modalFormIn_headerLabel modalFormIn) + R.text (_in_headerLabel input) R.divClass "formContent" $ do rec - form <- _modalFormIn_form modalFormIn + form <- _in_form input (validate, cancel, confirm) <- R.divClass "buttons" $ do rec - cancel <- Button._buttonOut_clic <$> (Button.button $ - (Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo)) - { _buttonIn_class = R.constDyn "undo" }) + cancel <- Button._out_clic <$> (Button.view $ + (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo)) + { Button._in_class = R.constDyn "undo" }) - confirm <- Button._buttonOut_clic <$> (Button.button $ - (Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm)) - { _buttonIn_class = R.constDyn "confirm" - , _buttonIn_waiting = waiting - , _buttonIn_submit = True + confirm <- Button._out_clic <$> (Button.view $ + (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm)) + { Button._in_class = R.constDyn "confirm" + , Button._in_waiting = waiting + , Button._in_submit = True }) (validate, waiting) <- WaitFor.waitFor - (_modalFormIn_ajax modalFormIn) + (_in_ajax input) (ValidationUtil.fireValidation form confirm) return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm) - return ModalFormOut - { _modalFormOut_hide = R.leftmost [ cancel, () <$ validate ] - , _modalFormOut_cancel = cancel - , _modalFormOut_confirm = confirm - , _modalFormOut_validate = validate + return Out + { _out_hide = R.leftmost [ cancel, () <$ validate ] + , _out_cancel = cancel + , _out_confirm = confirm + , _out_validate = validate } -- cgit v1.2.3 From e4b32ce15f8c92f3b477d3f3d4d301ba08f9b5e3 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 23 Oct 2019 22:35:27 +0200 Subject: Edit an income --- client/src/Component/ModalForm.hs | 50 ++++++++++++++++++++------------------- 1 file changed, 26 insertions(+), 24 deletions(-) (limited to 'client/src/Component/ModalForm.hs') diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs index ea53beb..f5bf287 100644 --- a/client/src/Component/ModalForm.hs +++ b/client/src/Component/ModalForm.hs @@ -15,6 +15,7 @@ import qualified Reflex.Dom as R import qualified Common.Msg as Msg import qualified Component.Button as Button +import qualified Component.Form as Form import qualified Util.Either as EitherUtil import qualified Util.Validation as ValidationUtil import qualified Util.WaitFor as WaitFor @@ -38,32 +39,33 @@ view input = R.divClass "formHeader" $ R.text (_in_headerLabel input) - R.divClass "formContent" $ do - rec - form <- _in_form input + Form.view $ + R.divClass "formContent" $ do + rec + form <- _in_form input - (validate, cancel, confirm) <- R.divClass "buttons" $ do - rec - cancel <- Button._out_clic <$> (Button.view $ - (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo)) - { Button._in_class = R.constDyn "undo" }) + (validate, cancel, confirm) <- R.divClass "buttons" $ do + rec + cancel <- Button._out_clic <$> (Button.view $ + (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo)) + { Button._in_class = R.constDyn "undo" }) - confirm <- Button._out_clic <$> (Button.view $ - (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm)) - { Button._in_class = R.constDyn "confirm" - , Button._in_waiting = waiting - , Button._in_submit = True - }) + confirm <- Button._out_clic <$> (Button.view $ + (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm)) + { Button._in_class = R.constDyn "confirm" + , Button._in_waiting = waiting + , Button._in_submit = True + }) - (validate, waiting) <- WaitFor.waitFor - (_in_ajax input) - (ValidationUtil.fireValidation form confirm) + (validate, waiting) <- WaitFor.waitFor + (_in_ajax input) + (ValidationUtil.fireValidation form confirm) - return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm) + return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm) - return Out - { _out_hide = R.leftmost [ cancel, () <$ validate ] - , _out_cancel = cancel - , _out_confirm = confirm - , _out_validate = validate - } + return Out + { _out_hide = R.leftmost [ cancel, () <$ validate ] + , _out_cancel = cancel + , _out_confirm = confirm + , _out_validate = validate + } -- cgit v1.2.3 From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 8 Dec 2019 11:39:37 +0100 Subject: Add category page --- client/src/Component/ModalForm.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'client/src/Component/ModalForm.hs') diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs index f5bf287..c56ff88 100644 --- a/client/src/Component/ModalForm.hs +++ b/client/src/Component/ModalForm.hs @@ -20,20 +20,20 @@ import qualified Util.Either as EitherUtil import qualified Util.Validation as ValidationUtil import qualified Util.WaitFor as WaitFor -data In m t a b e = In +data In m t a e = In { _in_headerLabel :: Text , _in_form :: m (Dynamic t (Validation e a)) - , _in_ajax :: Event t a -> m (Event t (Either Text b)) + , _in_ajax :: Event t a -> m (Event t (Either Text ())) } -data Out t a = Out +data Out t = Out { _out_hide :: Event t () , _out_cancel :: Event t () , _out_confirm :: Event t () - , _out_validate :: Event t a + , _out_validate :: Event t () } -view :: forall t m a b e. (MonadWidget t m, ToJSON a) => In m t a b e -> m (Out t b) +view :: forall t m a e. (MonadWidget t m, ToJSON a) => In m t a e -> m (Out t) view input = R.divClass "form" $ do R.divClass "formHeader" $ -- cgit v1.2.3