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/Button.hs | 41 +++++++++++++++++++++++++++++------------ 1 file changed, 29 insertions(+), 12 deletions(-) (limited to 'client/src/Component/Button.hs') diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs index 3ee9561..bf604f1 100644 --- a/client/src/Component/Button.hs +++ b/client/src/Component/Button.hs @@ -2,10 +2,11 @@ module Component.Button ( ButtonIn(..) , ButtonOut(..) , button - , buttonInDefault + , defaultButtonIn ) where import qualified Data.Map as M +import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget) @@ -14,22 +15,36 @@ import qualified Reflex.Dom as R import qualified Icon data ButtonIn t m = ButtonIn - { _buttonIn_class :: Dynamic t Text - , _buttonIn_content :: m () - , _buttonIn_waiting :: Event t Bool + { _buttonIn_class :: Dynamic t Text + , _buttonIn_content :: m () + , _buttonIn_waiting :: Event t Bool + , _buttonIn_tabIndex :: Maybe Int + , _buttonIn_submit :: Bool } -buttonInDefault :: forall t m. (MonadWidget t m) => ButtonIn t m -buttonInDefault = ButtonIn - { _buttonIn_class = R.constDyn "" - , _buttonIn_content = R.blank - , _buttonIn_waiting = R.never +defaultButtonIn :: MonadWidget t m => m () -> ButtonIn t m +defaultButtonIn content = ButtonIn + { _buttonIn_class = R.constDyn "" + , _buttonIn_content = content + , _buttonIn_waiting = R.never + , _buttonIn_tabIndex = Nothing + , _buttonIn_submit = False } +-- defaultButtonIn :: MonadWidget t m => ButtonIn t m +-- defaultButtonIn = ButtonIn +-- { _buttonIn_class = R.constDyn "" +-- , _buttonIn_content = R.blank +-- , _buttonIn_waiting = R.never +-- , _buttonIn_tabIndex = Nothing +-- , _buttonIn_submit = False +-- } + data ButtonOut t = ButtonOut { _buttonOut_clic :: Event t () } + button :: forall t m. MonadWidget t m => ButtonIn t m -> m (ButtonOut t) button buttonIn = do dynWaiting <- R.holdDyn False $ _buttonIn_waiting buttonIn @@ -37,9 +52,11 @@ button buttonIn = do let attr = do buttonClass <- _buttonIn_class buttonIn waiting <- dynWaiting - return $ if waiting - then M.fromList [("type", "button"), ("class", T.intercalate " " [ buttonClass, "waiting" ])] - else M.fromList [("type", "button"), ("class", buttonClass)] + return . M.fromList . catMaybes $ + [ Just ("type", if _buttonIn_submit buttonIn then "submit" else "button") + , (\i -> ("tabindex", T.pack . show $ i)) <$> _buttonIn_tabIndex buttonIn + , Just ("class", T.intercalate " " [ buttonClass, if waiting then "waiting" else "" ]) + ] (e, _) <- R.elDynAttr' "button" attr $ do Icon.loading -- cgit v1.2.3