Use a better project structure

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
+    }