From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- client/src/Component/Select.hs | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 client/src/Component/Select.hs (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs new file mode 100644 index 0000000..876548e --- /dev/null +++ b/client/src/Component/Select.hs @@ -0,0 +1,32 @@ +module Component.Select + ( SelectIn(..) + , SelectOut(..) + , select + ) where + +import Data.Map (Map) +import Data.Text (Text) +import Reflex.Dom (Dynamic, MonadWidget, Reflex) +import qualified Reflex.Dom as R + +data (Reflex t) => SelectIn t a = SelectIn + { _selectIn_label :: Text + , _selectIn_initialValue :: a + , _selectIn_values :: Dynamic t (Map a Text) + } + +data SelectOut t a = SelectOut + { _selectOut_value :: Dynamic t a + } + +select :: forall t m a. (Ord a) => MonadWidget t m => SelectIn t a -> m (SelectOut t a) +select selectIn = + R.divClass "selectInput" $ do + R.el "label" $ R.text (_selectIn_label selectIn) + + value <- R._dropdown_value <$> + R.dropdown (_selectIn_initialValue selectIn) (_selectIn_values selectIn) R.def + + return SelectOut + { _selectOut_value = value + } -- cgit v1.2.3 From 40b4994797a797b1fa86cafda789a5c488730c6d Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Oct 2018 17:57:58 +0100 Subject: Delete payment --- client/src/Component/Select.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 876548e..17a4958 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -19,7 +19,7 @@ data SelectOut t a = SelectOut { _selectOut_value :: Dynamic t a } -select :: forall t m a. (Ord a) => MonadWidget t m => SelectIn t a -> m (SelectOut t a) +select :: forall t m a. (Ord a, MonadWidget t m) => SelectIn t a -> m (SelectOut t a) select selectIn = R.divClass "selectInput" $ do R.el "label" $ R.text (_selectIn_label selectIn) -- cgit v1.2.3 From 50fb8fa48d1c4881da20b4ecf6d68a772301e713 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 30 Oct 2018 18:04:58 +0100 Subject: Update table when adding or removing a payment --- client/src/Component/Select.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 17a4958..7cb6726 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -6,13 +6,14 @@ module Component.Select import Data.Map (Map) import Data.Text (Text) -import Reflex.Dom (Dynamic, MonadWidget, Reflex) +import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex) import qualified Reflex.Dom as R data (Reflex t) => SelectIn t a = SelectIn { _selectIn_label :: Text , _selectIn_initialValue :: a , _selectIn_values :: Dynamic t (Map a Text) + , _selectIn_reset :: Event t () } data SelectOut t a = SelectOut @@ -24,8 +25,13 @@ select selectIn = R.divClass "selectInput" $ do R.el "label" $ R.text (_selectIn_label selectIn) + let initialValue = _selectIn_initialValue selectIn + value <- R._dropdown_value <$> - R.dropdown (_selectIn_initialValue selectIn) (_selectIn_values selectIn) R.def + R.dropdown + initialValue + (_selectIn_values selectIn) + (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) }) return SelectOut { _selectOut_value = value -- cgit v1.2.3 From 2741f47ef7b87255203bc2f7f7b2b9140c70b8f0 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 1 Nov 2018 13:14:25 +0100 Subject: Implementing client side validation --- client/src/Component/Select.hs | 61 +++++++++++++++++++++++++++++++----------- 1 file changed, 46 insertions(+), 15 deletions(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 7cb6726..9f671d3 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -5,34 +5,65 @@ module Component.Select ) where import Data.Map (Map) +import qualified Data.Map as M import Data.Text (Text) +import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex) import qualified Reflex.Dom as R -data (Reflex t) => SelectIn t a = SelectIn +import qualified Common.Msg as Msg + +data (Reflex t) => SelectIn t a b c = SelectIn { _selectIn_label :: Text , _selectIn_initialValue :: a , _selectIn_values :: Dynamic t (Map a Text) - , _selectIn_reset :: Event t () + , _selectIn_reset :: Event t b + , _selectIn_isValid :: a -> Bool + , _selectIn_validate :: Event t c } data SelectOut t a = SelectOut { _selectOut_value :: Dynamic t a } -select :: forall t m a. (Ord a, MonadWidget t m) => SelectIn t a -> m (SelectOut t a) -select selectIn = - R.divClass "selectInput" $ do - R.el "label" $ R.text (_selectIn_label selectIn) +select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a) +select selectIn = do + rec + let containerAttr = R.ffor hasError (\e -> + M.singleton "class" $ T.intercalate " " + [ "selectInput" + , if e then "error" else "" + ]) + + hasError <- R.holdDyn False $ R.attachWith + (\v clearError -> not clearError && not (_selectIn_isValid selectIn v)) + (R.current value) + (R.leftmost + [ const False <$> _selectIn_validate selectIn + , const True <$> _selectIn_reset selectIn + ]) + + value <- R.elDynAttr "div" containerAttr $ do + R.el "label" $ R.text (_selectIn_label selectIn) + + let initialValue = _selectIn_initialValue selectIn + + value <- R._dropdown_value <$> + R.dropdown + initialValue + (_selectIn_values selectIn) + (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) }) + + errorMessage <- R.holdDyn "" $ R.attachWith + (\v _ -> if (_selectIn_isValid selectIn) v then "" else "ERROR!") + (R.current value) + (_selectIn_validate selectIn) - let initialValue = _selectIn_initialValue selectIn + R.divClass "errorMessage" . R.dynText $ + R.ffor hasError (\e -> if e then Msg.get Msg.Form_NonEmpty else "") - value <- R._dropdown_value <$> - R.dropdown - initialValue - (_selectIn_values selectIn) - (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) }) + return value - return SelectOut - { _selectOut_value = value - } + return SelectOut + { _selectOut_value = value + } -- cgit v1.2.3 From fc8be14dd0089eb12b78af7aaaecd8ed57896677 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 7 Aug 2019 21:27:59 +0200 Subject: Update category according to payment in add overlay --- client/src/Component/Select.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 9f671d3..43a8a6e 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -16,6 +16,7 @@ import qualified Common.Msg as Msg data (Reflex t) => SelectIn t a b c = SelectIn { _selectIn_label :: Text , _selectIn_initialValue :: a + , _selectIn_value :: Event t a , _selectIn_values :: Dynamic t (Map a Text) , _selectIn_reset :: Event t b , _selectIn_isValid :: a -> Bool @@ -48,11 +49,16 @@ select selectIn = do let initialValue = _selectIn_initialValue selectIn + let setValue = R.leftmost + [ const initialValue <$> (_selectIn_reset selectIn) + , _selectIn_value selectIn + ] + value <- R._dropdown_value <$> R.dropdown initialValue (_selectIn_values selectIn) - (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) }) + (R.def { R._dropdownConfig_setValue = setValue }) errorMessage <- R.holdDyn "" $ R.attachWith (\v _ -> if (_selectIn_isValid selectIn) v then "" else "ERROR!") -- cgit v1.2.3 From 7c77e52faa71e43324087903c905f9d493b1dfb7 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 8 Aug 2019 21:28:22 +0200 Subject: Finish payment add modal --- client/src/Component/Select.hs | 54 +++++++++++++++++++++++------------------- 1 file changed, 30 insertions(+), 24 deletions(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 43a8a6e..01ed37a 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -4,14 +4,17 @@ module Component.Select , select ) where -import Data.Map (Map) -import qualified Data.Map as M -import Data.Text (Text) -import qualified Data.Text as T -import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex) -import qualified Reflex.Dom as R +import Data.Map (Map) +import qualified Data.Map as M +import qualified Data.Maybe as Maybe +import Data.Text (Text) +import qualified Data.Text as T +import Data.Validation (Validation (Failure, Success)) +import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex) +import qualified Reflex.Dom as R -import qualified Common.Msg as Msg +import qualified Common.Msg as Msg +import qualified Util.Validation as ValidationUtil data (Reflex t) => SelectIn t a b c = SelectIn { _selectIn_label :: Text @@ -24,25 +27,33 @@ data (Reflex t) => SelectIn t a b c = SelectIn } data SelectOut t a = SelectOut - { _selectOut_value :: Dynamic t a + { _selectOut_value :: Dynamic t (Validation Text a) } select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a) select selectIn = do rec - let containerAttr = R.ffor hasError (\e -> + let containerAttr = R.ffor showedError (\e -> M.singleton "class" $ T.intercalate " " [ "selectInput" - , if e then "error" else "" + , if Maybe.isJust e then "error" else "" ]) - hasError <- R.holdDyn False $ R.attachWith - (\v clearError -> not clearError && not (_selectIn_isValid selectIn v)) - (R.current value) - (R.leftmost - [ const False <$> _selectIn_validate selectIn - , const True <$> _selectIn_reset selectIn - ]) + validatedValue = + R.ffor value (\v -> + if _selectIn_isValid selectIn v then + Success v + else + Failure (Msg.get Msg.Form_NonEmpty)) + + maybeError = + fmap ValidationUtil.maybeError validatedValue + + showedError <- R.holdDyn Nothing $ R.leftmost + [ const Nothing <$> _selectIn_reset selectIn + , R.updated maybeError + , R.attachWith const (R.current maybeError) (_selectIn_validate selectIn) + ] value <- R.elDynAttr "div" containerAttr $ do R.el "label" $ R.text (_selectIn_label selectIn) @@ -60,16 +71,11 @@ select selectIn = do (_selectIn_values selectIn) (R.def { R._dropdownConfig_setValue = setValue }) - errorMessage <- R.holdDyn "" $ R.attachWith - (\v _ -> if (_selectIn_isValid selectIn) v then "" else "ERROR!") - (R.current value) - (_selectIn_validate selectIn) - R.divClass "errorMessage" . R.dynText $ - R.ffor hasError (\e -> if e then Msg.get Msg.Form_NonEmpty else "") + R.ffor showedError (Maybe.fromMaybe "") return value return SelectOut - { _selectOut_value = value + { _selectOut_value = validatedValue } -- cgit v1.2.3 From 234b5b29361734656dc780148309962f932d9907 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 10 Aug 2019 15:07:11 +0200 Subject: Use select component in payment search line --- client/src/Component/Select.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 01ed37a..cf62f26 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -27,7 +27,8 @@ data (Reflex t) => SelectIn t a b c = SelectIn } data SelectOut t a = SelectOut - { _selectOut_value :: Dynamic t (Validation Text a) + { _selectOut_raw :: Dynamic t a + , _selectOut_value :: Dynamic t (Validation Text a) } select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a) @@ -77,5 +78,6 @@ select selectIn = do return value return SelectOut - { _selectOut_value = validatedValue + { _selectOut_raw = value + , _selectOut_value = validatedValue } -- cgit v1.2.3 From c542424b7b41c78a170763f6996c12f56b359860 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 10 Aug 2019 21:31:27 +0200 Subject: Add smooth transitions to modal show and hide --- client/src/Component/Select.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index cf62f26..9a37afc 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -51,7 +51,7 @@ select selectIn = do fmap ValidationUtil.maybeError validatedValue showedError <- R.holdDyn Nothing $ R.leftmost - [ const Nothing <$> _selectIn_reset selectIn + [ Nothing <$ _selectIn_reset selectIn , R.updated maybeError , R.attachWith const (R.current maybeError) (_selectIn_validate selectIn) ] @@ -62,7 +62,7 @@ select selectIn = do let initialValue = _selectIn_initialValue selectIn let setValue = R.leftmost - [ const initialValue <$> (_selectIn_reset selectIn) + [ initialValue <$ (_selectIn_reset selectIn) , _selectIn_value selectIn ] -- cgit v1.2.3 From 2cbd43c3a0f0640776a4e7c7425b3210d2e6632b Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 6 Oct 2019 19:41:17 +0200 Subject: Make input label clickable again --- client/src/Component/Select.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 9a37afc..5980ed2 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -57,8 +57,6 @@ select selectIn = do ] value <- R.elDynAttr "div" containerAttr $ do - R.el "label" $ R.text (_selectIn_label selectIn) - let initialValue = _selectIn_initialValue selectIn let setValue = R.leftmost @@ -66,11 +64,15 @@ select selectIn = do , _selectIn_value selectIn ] - value <- R._dropdown_value <$> - R.dropdown - initialValue - (_selectIn_values selectIn) - (R.def { R._dropdownConfig_setValue = setValue }) + value <- R.el "label" $ do + R.divClass "label" $ + R.text (_selectIn_label selectIn) + + R._dropdown_value <$> + R.dropdown + initialValue + (_selectIn_values selectIn) + (R.def { R._dropdownConfig_setValue = setValue }) R.divClass "errorMessage" . R.dynText $ R.ffor showedError (Maybe.fromMaybe "") -- cgit v1.2.3 From 7529a18ff0ac443e7f9764b5e2d0f57a5d3a850b Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 9 Oct 2019 23:16:00 +0200 Subject: Use common payment validation in the backend Remove deprecated backend validation --- client/src/Component/Select.hs | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 5980ed2..102f554 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -9,11 +9,10 @@ import qualified Data.Map as M import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T -import Data.Validation (Validation (Failure, Success)) +import Data.Validation (Validation) import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex) import qualified Reflex.Dom as R -import qualified Common.Msg as Msg import qualified Util.Validation as ValidationUtil data (Reflex t) => SelectIn t a b c = SelectIn @@ -22,7 +21,7 @@ data (Reflex t) => SelectIn t a b c = SelectIn , _selectIn_value :: Event t a , _selectIn_values :: Dynamic t (Map a Text) , _selectIn_reset :: Event t b - , _selectIn_isValid :: a -> Bool + , _selectIn_isValid :: a -> Validation Text a , _selectIn_validate :: Event t c } @@ -41,11 +40,7 @@ select selectIn = do ]) validatedValue = - R.ffor value (\v -> - if _selectIn_isValid selectIn v then - Success v - else - Failure (Msg.get Msg.Form_NonEmpty)) + fmap (_selectIn_isValid selectIn) value maybeError = fmap ValidationUtil.maybeError validatedValue -- 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/Select.hs | 56 +++++++++++++++++++++--------------------- 1 file changed, 28 insertions(+), 28 deletions(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 102f554..375ae06 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -1,7 +1,7 @@ module Component.Select - ( SelectIn(..) - , SelectOut(..) - , select + ( view + , In(..) + , Out(..) ) where import Data.Map (Map) @@ -15,58 +15,58 @@ import qualified Reflex.Dom as R import qualified Util.Validation as ValidationUtil -data (Reflex t) => SelectIn t a b c = SelectIn - { _selectIn_label :: Text - , _selectIn_initialValue :: a - , _selectIn_value :: Event t a - , _selectIn_values :: Dynamic t (Map a Text) - , _selectIn_reset :: Event t b - , _selectIn_isValid :: a -> Validation Text a - , _selectIn_validate :: Event t c +data (Reflex t) => In t a b c = In + { _in_label :: Text + , _in_initialValue :: a + , _in_value :: Event t a + , _in_values :: Dynamic t (Map a Text) + , _in_reset :: Event t b + , _in_isValid :: a -> Validation Text a + , _in_validate :: Event t c } -data SelectOut t a = SelectOut - { _selectOut_raw :: Dynamic t a - , _selectOut_value :: Dynamic t (Validation Text a) +data Out t a = Out + { _out_raw :: Dynamic t a + , _out_value :: Dynamic t (Validation Text a) } -select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a) -select selectIn = do +view :: forall t m a b c. (Ord a, MonadWidget t m) => In t a b c -> m (Out t a) +view input = do rec let containerAttr = R.ffor showedError (\e -> M.singleton "class" $ T.intercalate " " - [ "selectInput" + [ "input" , if Maybe.isJust e then "error" else "" ]) validatedValue = - fmap (_selectIn_isValid selectIn) value + fmap (_in_isValid input) value maybeError = fmap ValidationUtil.maybeError validatedValue showedError <- R.holdDyn Nothing $ R.leftmost - [ Nothing <$ _selectIn_reset selectIn + [ Nothing <$ _in_reset input , R.updated maybeError - , R.attachWith const (R.current maybeError) (_selectIn_validate selectIn) + , R.attachWith const (R.current maybeError) (_in_validate input) ] value <- R.elDynAttr "div" containerAttr $ do - let initialValue = _selectIn_initialValue selectIn + let initialValue = _in_initialValue input let setValue = R.leftmost - [ initialValue <$ (_selectIn_reset selectIn) - , _selectIn_value selectIn + [ initialValue <$ (_in_reset input) + , _in_value input ] value <- R.el "label" $ do R.divClass "label" $ - R.text (_selectIn_label selectIn) + R.text (_in_label input) R._dropdown_value <$> R.dropdown initialValue - (_selectIn_values selectIn) + (_in_values input) (R.def { R._dropdownConfig_setValue = setValue }) R.divClass "errorMessage" . R.dynText $ @@ -74,7 +74,7 @@ select selectIn = do return value - return SelectOut - { _selectOut_raw = value - , _selectOut_value = validatedValue + return Out + { _out_raw = value + , _out_value = validatedValue } -- cgit v1.2.3 From 4c79ca374e030454f62a467fb4f2197d372e9bc1 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Nov 2019 15:53:46 +0100 Subject: Fix select input style --- client/src/Component/Select.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'client/src/Component/Select.hs') diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 375ae06..70f5f58 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -35,7 +35,7 @@ view input = do rec let containerAttr = R.ffor showedError (\e -> M.singleton "class" $ T.intercalate " " - [ "input" + [ "input selectInput" , if Maybe.isJust e then "error" else "" ]) -- cgit v1.2.3