diff options
author | Joris | 2017-09-24 22:14:48 +0200 |
---|---|---|
committer | Joris | 2017-11-07 09:33:01 +0100 |
commit | 898e7ed11ab0958fcdaf65b99b33f7b04787630a (patch) | |
tree | 8b5ab951c36d7d27550a7c4eaad16bbd2cd0edb1 /src/client/Component | |
parent | 14bdbc8c937f5d0b35c61350dba28cb41c3737cd (diff) | |
download | budget-898e7ed11ab0958fcdaf65b99b33f7b04787630a.tar.gz budget-898e7ed11ab0958fcdaf65b99b33f7b04787630a.tar.bz2 budget-898e7ed11ab0958fcdaf65b99b33f7b04787630a.zip |
Bootstrap with GHCJS and reflex:
- setup login and logout,
- first draft of payment view.
Diffstat (limited to 'src/client/Component')
-rw-r--r-- | src/client/Component/Button.hs | 53 | ||||
-rw-r--r-- | src/client/Component/Input.hs | 34 |
2 files changed, 87 insertions, 0 deletions
diff --git a/src/client/Component/Button.hs b/src/client/Component/Button.hs new file mode 100644 index 0000000..f21798c --- /dev/null +++ b/src/client/Component/Button.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings #-} + +module Component.Button + ( ButtonIn(..) + , buttonInDefault + , ButtonOut(..) + , button + ) where + +import qualified Data.Map as M +import Data.Monoid ((<>)) +import Data.Text (Text) +import qualified Data.Text as T +import Reflex.Dom (MonadWidget, Event) +import qualified Reflex.Dom as R + +import qualified Icon + +data ButtonIn t m = ButtonIn + { _buttonIn_class :: Text + , _buttonIn_content :: m () + , _buttonIn_waiting :: Event t Bool + } + +buttonInDefault :: forall t m. MonadWidget t m => ButtonIn t m +buttonInDefault = ButtonIn + { _buttonIn_class = "" + , _buttonIn_content = R.blank + , _buttonIn_waiting = R.never + } + +data ButtonOut t = ButtonOut + { _buttonOut_clic :: Event t () + } + +button :: forall t m. MonadWidget t m => ButtonIn t m -> m (ButtonOut t) +button buttonIn = do + attr <- R.holdDyn + (M.fromList [("type", "button"), ("class", _buttonIn_class buttonIn)]) + (fmap + (\w -> M.fromList $ + [ ("type", "button") ] + <> if w + then [("class", T.concat [ _buttonIn_class buttonIn, " waiting" ])] + else [("class", _buttonIn_class buttonIn)]) + (_buttonIn_waiting buttonIn)) + (e, _) <- R.elDynAttr' "button" attr $ do + Icon.loading + R.divClass "content" $ _buttonIn_content buttonIn + return $ ButtonOut + { _buttonOut_clic = R.domEvent R.Click e + } diff --git a/src/client/Component/Input.hs b/src/client/Component/Input.hs new file mode 100644 index 0000000..7111630 --- /dev/null +++ b/src/client/Component/Input.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings #-} + +module Component.Input + ( InputIn(..) + , InputOut(..) + , input + ) where + +import Data.Text (Text) +import Reflex.Dom (MonadWidget, Dynamic, Event, (&), (.~), (=:)) +import qualified Reflex.Dom as R + +data InputIn t a b = InputIn + { _inputIn_reset :: Event t a + , _inputIn_placeHolder :: Text + } + +data InputOut t = InputOut + { _inputOut_value :: Dynamic t Text + , _inputOut_enter :: Event t () + } + +input :: forall t m a b. MonadWidget t m => InputIn t a b -> m (InputOut t) +input inputIn = do + let placeHolder = R.constDyn ("placeHolder" =: _inputIn_placeHolder inputIn) + let value = fmap (const "") (_inputIn_reset inputIn) + textInput <- R.textInput $ R.def & R.attributes .~ placeHolder + & R.setValue .~ value + let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput + return $ InputOut + { _inputOut_value = R._textInput_value textInput + , _inputOut_enter = enter + } |