1 files changed, 57 insertions, 0 deletions
diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
new file mode 100644
index 0000000..153a61b
--- /dev/null
+++ b/client/src/Component/Button.hs
@@ -0,0 +1,57 @@
+module Component.Button
+  ( In(..)
+  , Out(..)
+  , view
+  , defaultIn
+  ) 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)
+import qualified Reflex.Dom as R
+
+import qualified View.Icon  as Icon
+
+data In t m = In
+  { _in_class    :: Dynamic t Text
+  , _in_content  :: m ()
+  , _in_waiting  :: Event t Bool
+  , _in_tabIndex :: Maybe Int
+  , _in_submit   :: Bool
+  }
+
+defaultIn :: forall t m. MonadWidget t m => m () -> In t m
+defaultIn content = In
+  { _in_class    = R.constDyn ""
+  , _in_content  = content
+  , _in_waiting  = R.never
+  , _in_tabIndex = Nothing
+  , _in_submit   = False
+  }
+
+data Out t = Out
+  { _out_clic :: Event t ()
+  }
+
+view :: forall t m. MonadWidget t m => In t m -> m (Out t)
+view input = do
+  dynWaiting <- R.holdDyn False $ _in_waiting input
+
+  let attr = do
+        buttonClass <- _in_class input
+        waiting <- dynWaiting
+        return . M.fromList . catMaybes $
+          [ Just ("type", if _in_submit input then "submit" else "button")
+          , (\i -> ("tabindex", T.pack . show $ i)) <$> _in_tabIndex input
+          , Just ("class", T.intercalate " " [ buttonClass, if waiting then "waiting" else "" ])
+          ]
+
+  (e, _) <- R.elDynAttr' "button" attr $ do
+    Icon.loading
+    R.divClass "content" $ _in_content input
+
+  return $ Out
+    { _out_clic = R.domEvent R.Click e
+    }