WIP

5 files changed, 107 insertions, 29 deletions

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
diff --git a/client/src/Component/Form.hs b/client/src/Component/Form.hs
new file mode 100644
index 0000000..0a89c6e
--- /dev/null
+++ b/client/src/Component/Form.hs
@@ -0,0 +1,12 @@
+module Component.Form
+  ( form
+  ) where
+
+import qualified Data.Map   as M
+import           Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+form :: forall t m a. (MonadWidget t m) => m a -> m a
+form content =
+  R.elAttr "form" (M.singleton "onsubmit" "event.preventDefault()") $
+    content
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 24aac22..92f8ec9 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -2,12 +2,14 @@ module Component.Input
   ( InputIn(..)
   , InputOut(..)
   , input
+  , defaultInputIn
   ) where
 
 import qualified Data.Map         as M
 import           Data.Text        (Text)
 import qualified Data.Text        as T
-import           Reflex.Dom       (Dynamic, Event, MonadWidget, (&), (.~))
+import           Reflex.Dom       (Dynamic, Event, MonadWidget, Reflex, (&),
+                                   (.~))
 import qualified Reflex.Dom       as R
 
 import           Component.Button (ButtonIn (..), ButtonOut (..))
@@ -15,8 +17,16 @@ import qualified Component.Button as Button
 import qualified Icon
 
 data InputIn t a b = InputIn
-  { _inputIn_reset :: Event t a
-  , _inputIn_label :: Text
+  { _inputIn_reset        :: Event t a
+  , _inputIn_label        :: Text
+  , _inputIn_initialValue :: Text
+  }
+
+defaultInputIn :: (Reflex t) => InputIn t a b
+defaultInputIn = InputIn
+  { _inputIn_reset        = R.never
+  , _inputIn_label        = ""
+  , _inputIn_initialValue = ""
   }
 
 data InputOut t = InputOut
@@ -41,14 +51,15 @@ input inputIn =
       textInput <- R.textInput $ R.def
         & R.attributes .~ attributes
         & R.setValue .~ resetValue
+        & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn)
 
       R.el "label" $ R.text (_inputIn_label inputIn)
 
-      reset <- Button.button $ ButtonIn
-        { _buttonIn_class   = R.constDyn "reset"
-        , _buttonIn_content = Icon.cross
-        , _buttonIn_waiting = R.never
-        }
+      reset <- Button.button $
+        (Button.defaultButtonIn Icon.cross)
+          { _buttonIn_class   = R.constDyn "reset"
+          , _buttonIn_tabIndex = Just (-1)
+          }
 
     let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
 
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index bfb5e02..1d70c90 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -10,18 +10,22 @@ import qualified Data.Map   as M
 import           Reflex.Dom (Event, MonadWidget)
 import qualified Reflex.Dom as R
 
-data ModalIn t m = ModalIn
+data ModalIn t m a = ModalIn
   { _modalIn_show    :: Event t ()
-  , _modalIn_content :: m ()
+  , _modalIn_hide    :: Event t ()
+  , _modalIn_content :: m a
   }
 
-data ModalOut = ModalOut {}
+data ModalOut a = ModalOut
+  { _modalOut_content :: a
+  }
 
-modal :: forall t m. MonadWidget t m => ModalIn t m -> m ModalOut
+modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut a)
 modal modalIn = do
   rec
     showModal <- R.holdDyn False $ R.leftmost
       [ True <$ _modalIn_show modalIn
+      , False <$ _modalIn_hide modalIn
       , False <$ curtainClick
       ]
 
@@ -30,9 +34,11 @@ modal modalIn = do
           , ("class", "modal")
           ])
 
-    curtainClick <- R.elDynAttr "div" attr $ do
-      (curtain, _) <- R.elAttr' "div" (M.singleton "class" "curtain") $ R.blank
-      R.divClass "content" $ _modalIn_content modalIn
-      return $ R.domEvent R.Click curtain
+    (curtainClick, content) <- R.elDynAttr "div" attr $ do
+      (curtain, _) <- R.elAttr' "div" (M.singleton "class" "modalCurtain") $ R.blank
+      cont <- R.divClass "modalContent" $ _modalIn_content modalIn
+      return (R.domEvent R.Click curtain, cont)
 
-  return $ ModalOut {}
+  return $ ModalOut
+    { _modalOut_content = content
+    }
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
new file mode 100644
index 0000000..876548e
--- /dev/null
+++ b/client/src/Component/Select.hs
@@ -0,0 +1,32 @@
+module Component.Select
+  ( SelectIn(..)
+  , SelectOut(..)
+  , select
+  ) where
+
+import           Data.Map   (Map)
+import           Data.Text  (Text)
+import           Reflex.Dom (Dynamic, MonadWidget, Reflex)
+import qualified Reflex.Dom as R
+
+data (Reflex t) => SelectIn t a = SelectIn
+  { _selectIn_label        :: Text
+  , _selectIn_initialValue :: a
+  , _selectIn_values       :: Dynamic t (Map a Text)
+  }
+
+data SelectOut t a = SelectOut
+  { _selectOut_value :: Dynamic t a
+  }
+
+select :: forall t m a. (Ord a) => MonadWidget t m => SelectIn t a -> m (SelectOut t a)
+select selectIn =
+  R.divClass "selectInput" $ do
+    R.el "label" $ R.text (_selectIn_label selectIn)
+
+    value <- R._dropdown_value <$>
+      R.dropdown (_selectIn_initialValue selectIn) (_selectIn_values selectIn) R.def
+
+    return SelectOut
+      { _selectOut_value = value
+      }