aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Component')
-rw-r--r--client/src/Component/Button.hs53
-rw-r--r--client/src/Component/Input.hs34
2 files changed, 87 insertions, 0 deletions
diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
new file mode 100644
index 0000000..f21798c
--- /dev/null
+++ b/client/src/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/client/src/Component/Input.hs b/client/src/Component/Input.hs
new file mode 100644
index 0000000..7111630
--- /dev/null
+++ b/client/src/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
+ }