aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Component')
-rw-r--r--client/src/Component/Appearing.hs10
-rw-r--r--client/src/Component/Button.hs57
-rw-r--r--client/src/Component/ConfirmDialog.hs49
-rw-r--r--client/src/Component/Form.hs12
-rw-r--r--client/src/Component/Input.hs151
-rw-r--r--client/src/Component/Link.hs33
-rw-r--r--client/src/Component/Modal.hs117
-rw-r--r--client/src/Component/ModalForm.hs71
-rw-r--r--client/src/Component/Pages.hs86
-rw-r--r--client/src/Component/Select.hs80
-rw-r--r--client/src/Component/Table.hs105
-rw-r--r--client/src/Component/Tag.hs27
12 files changed, 0 insertions, 798 deletions
diff --git a/client/src/Component/Appearing.hs b/client/src/Component/Appearing.hs
deleted file mode 100644
index e0144ca..0000000
--- a/client/src/Component/Appearing.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module Component.Appearing
- ( view
- ) where
-
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
-
-view :: forall t m a. MonadWidget t m => m a -> m a
-view =
- R.divClass "g-Appearing"
diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
deleted file mode 100644
index 153a61b..0000000
--- a/client/src/Component/Button.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-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
- }
diff --git a/client/src/Component/ConfirmDialog.hs b/client/src/Component/ConfirmDialog.hs
deleted file mode 100644
index cf26593..0000000
--- a/client/src/Component/ConfirmDialog.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-module Component.ConfirmDialog
- ( In(..)
- , view
- ) where
-
-import Data.Text (Text)
-import Reflex.Dom (Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import qualified Common.Msg as Msg
-import qualified Component.Button as Button
-import qualified Component.Modal as Modal
-import qualified Util.Either as EitherUtil
-import qualified Util.WaitFor as WaitFor
-
-data In t m = In
- { _in_header :: Text
- , _in_confirm :: Event t () -> m (Event t ())
- }
-
-view :: forall t m a. MonadWidget t m => (In t m) -> Modal.Content t m
-view input _ =
- R.divClass "confirm" $ do
- R.divClass "confirmHeader" $
- R.text $ _in_header input
-
- R.divClass "confirmContent" $ do
- (confirm, cancel) <- R.divClass "buttons" $ do
-
- cancel <- Button._out_clic <$> (Button.view $
- (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
- { Button._in_class = R.constDyn "undo" })
-
- rec
- confirm <- Button._out_clic <$> (Button.view $
- (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
- { Button._in_class = R.constDyn "confirm"
- , Button._in_submit = True
- , Button._in_waiting = waiting
- })
-
- (result, waiting) <- WaitFor.waitFor (_in_confirm input) confirm
-
- return (result, cancel)
-
- return $
- ( R.leftmost [ cancel, () <$ confirm ]
- , confirm
- )
diff --git a/client/src/Component/Form.hs b/client/src/Component/Form.hs
deleted file mode 100644
index 6878e68..0000000
--- a/client/src/Component/Form.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Component.Form
- ( view
- ) where
-
-import qualified Data.Map as M
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
-
-view :: forall t m a. MonadWidget t m => m a -> m a
-view content =
- R.elAttr "form" (M.singleton "onsubmit" "event.preventDefault()") $
- content
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
deleted file mode 100644
index bcff377..0000000
--- a/client/src/Component/Input.hs
+++ /dev/null
@@ -1,151 +0,0 @@
-module Component.Input
- ( In(..)
- , Out(..)
- , view
- , defaultIn
- ) where
-
-import qualified Data.Map as M
-import qualified Data.Maybe as Maybe
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time (NominalDiffTime)
-import Data.Validation (Validation (Failure, Success))
-import qualified Data.Validation as V
-import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex,
- (&), (.~))
-import qualified Reflex.Dom as R
-
-import qualified Common.Util.Validation as ValidationUtil
-import qualified Component.Button as Button
-import qualified View.Icon as Icon
-
-data In a = In
- { _in_hasResetButton :: Bool
- , _in_label :: Text
- , _in_initialValue :: Text
- , _in_inputType :: Text
- , _in_validation :: Text -> Validation Text a
- }
-
-defaultIn :: In Text
-defaultIn = In
- { _in_hasResetButton = True
- , _in_label = ""
- , _in_initialValue = ""
- , _in_inputType = "text"
- , _in_validation = V.Success
- }
-
-data Out t a = Out
- { _out_raw :: Dynamic t Text
- , _out_value :: Dynamic t (Validation Text a)
- , _out_enter :: Event t ()
- }
-
-view
- :: forall t m a b. MonadWidget t m
- => In a
- -> Event t Text -- reset
- -> Event t b -- validate
- -> m (Out t a)
-view input reset validate = do
- rec
- let resetValue = R.leftmost
- [ reset
- , fmap (const "") resetClic
- ]
-
- inputAttr = R.ffor value (\v ->
- if T.null v && _in_inputType input /= "date" && _in_inputType input /= "color"
- then M.empty
- else M.singleton "class" "filled")
-
- value = R._textInput_value textInput
-
- containerAttr = R.ffor inputError (\e ->
- M.singleton "class" $ T.intercalate " "
- [ "textInput"
- , if Maybe.isJust e then "error" else ""
- ])
-
- let valueWithValidation = R.ffor value (\v -> (v, _in_validation input $ v))
- inputError <- getInputError valueWithValidation validate
-
- (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do
-
- textInput <- R.el "label" $ do
- textInput <- R.textInput $ R.def
- & R.attributes .~ inputAttr
- & R.setValue .~ resetValue
- & R.textInputConfig_initialValue .~ (_in_initialValue input)
- & R.textInputConfig_inputType .~ (_in_inputType input)
-
- R.divClass "label" $
- R.text (_in_label input)
-
- return textInput
-
- resetClic <-
- if _in_hasResetButton input
- then
- Button._out_clic <$> (Button.view $
- (Button.defaultIn Icon.cross)
- { Button._in_class = R.constDyn "reset"
- , Button._in_tabIndex = Just (-1)
- })
- else
- return R.never
-
- R.divClass "errorMessage" $
- R.dynText . fmap (Maybe.fromMaybe "") $ inputError
-
- return (textInput, resetClic)
-
- let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
-
- return $ Out
- { _out_raw = value
- , _out_value = fmap snd valueWithValidation
- , _out_enter = enter
- }
-
-getInputError
- :: forall t m a b c. MonadWidget t m
- => Dynamic t (Text, Validation Text a)
- -> Event t c
- -> m (Dynamic t (Maybe Text))
-getInputError validatedValue validate = do
- let errorDynamic = fmap (\(t, v) -> (t, validationError v)) validatedValue
- errorEvent = R.updated errorDynamic
- delayedError <- R.debounce (1 :: NominalDiffTime) errorEvent
- fmap (fmap fst) $ R.foldDyn
- (\event (err, hasBeenResetted) ->
- case event of
- ModifiedEvent t ->
- (Nothing, T.null t)
-
- ValidateEvent e ->
- (e, False)
-
- DelayEvent e ->
- if hasBeenResetted then
- (Nothing, False)
- else
- (e, False)
- )
- (Nothing, False)
- (R.leftmost
- [ fmap (\(t, _) -> ModifiedEvent t) errorEvent
- , fmap (\(_, e) -> DelayEvent e) delayedError
- , R.attachWith (\(_, e) _ -> ValidateEvent e) (R.current errorDynamic) validate
- ])
-
-validationError :: (Validation Text a) -> Maybe Text
-validationError (Failure e) = Just e
-validationError _ = Nothing
-
-data InputEvent
- = ModifiedEvent Text
- | DelayEvent (Maybe Text)
- | ValidateEvent (Maybe Text)
diff --git a/client/src/Component/Link.hs b/client/src/Component/Link.hs
deleted file mode 100644
index 1fd620e..0000000
--- a/client/src/Component/Link.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-module Component.Link
- ( view
- ) where
-
-import Data.Map (Map)
-import qualified Data.Map as M
-import Data.Text (Text)
-import qualified Data.Text as T
-import Reflex.Dom (Dynamic, MonadWidget)
-import qualified Reflex.Dom as R
-
-view :: forall t m a. MonadWidget t m => Text -> Dynamic t (Map Text Text) -> Text -> m ()
-view href inputAttrs content =
- R.elDynAttr "a" attrs (R.text content)
- where
-
- onclickHandler =
- T.intercalate ";"
- [ "history.pushState(0, '', event.target.href)"
- , "dispatchEvent(new PopStateEvent('popstate', {cancelable: true, bubbles: true, view: window}))"
- , "return false"
- ]
-
- attrs =
- R.ffor inputAttrs (\as ->
- (M.union
- (M.fromList
- [ ("onclick", onclickHandler)
- , ("href", href)
- ]
- )
- as)
- )
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
deleted file mode 100644
index 46d3f64..0000000
--- a/client/src/Component/Modal.hs
+++ /dev/null
@@ -1,117 +0,0 @@
-module Component.Modal
- ( In(..)
- , Content
- , view
- ) where
-
-import Control.Monad (void)
-import qualified Data.Map as M
-import qualified Data.Map.Lazy as LM
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time.Clock (NominalDiffTime)
-import qualified GHCJS.DOM.Element as Element
-import qualified GHCJS.DOM.Node as Node
-import JSDOM.Types (JSString)
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-import qualified Reflex.Dom.Class as R
-
-import qualified Util.Reflex as ReflexUtil
-
--- Content = CurtainClickEvent -> (CancelEvent, ConfirmEvent)
-type Content t m = Event t () -> m (Event t (), Event t ())
-
-data In t m = In
- { _in_show :: Event t ()
- , _in_content :: Content t m
- }
-
-view :: forall t m a. MonadWidget t m => In t m -> m (Event t ())
-view input = do
- rec
- let show = Show <$ (_in_show input)
-
- startHiding =
- R.attachWithMaybe
- (\a _ -> if a then Just StartHiding else Nothing)
- (R.current canBeHidden)
- (R.leftmost [ hide, curtainClick ])
-
- canBeHidden <-
- R.holdDyn True $ R.leftmost
- [ False <$ startHiding
- , True <$ endHiding
- ]
-
- endHiding <-
- R.delay (0.2 :: NominalDiffTime) (EndHiding <$ startHiding)
-
- let action =
- R.leftmost [ show, startHiding, endHiding ]
-
- modalClass <-
- R.holdDyn "" (fmap getModalClass action)
-
- (elem, dyn) <-
- R.buildElement "div" (getAttributes <$> modalClass) $
- ReflexUtil.visibleIfEvent
- (isVisible <$> action)
- (R.blank >> return (R.never, R.never, R.never))
- (do
- (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
- let curtainClick = R.domEvent R.Click curtain
- (hide, content) <- R.divClass "g-Modal__Content" (_in_content input curtainClick)
- return (curtainClick, hide, content))
-
-
- performShowEffects action elem
-
- let curtainClick = R.switchDyn $ (\(a, _, _) -> a) <$> dyn
- let hide = R.switchDyn $ (\(_, b, _) -> b) <$> dyn
- let content = R.switchDyn $ (\(_, _, c) -> c) <$> dyn
-
- -- Delay the event in order to let time for the modal to disappear
- R.delay (0.5 :: NominalDiffTime) content
-
-getAttributes :: Text -> LM.Map Text Text
-getAttributes modalClass =
- M.singleton "class" $
- T.intercalate " " [ "g-Modal", modalClass]
-
-performShowEffects
- :: forall t m a. MonadWidget t m
- => Event t Action
- -> Element.Element
- -> m ()
-performShowEffects showEvent elem = do
- body <- ReflexUtil.getBody
-
- let showEffects =
- flip fmap showEvent (\case
- Show -> do
- Node.appendChild body elem
- Element.setClassName body ("g-Body--Modal" :: JSString)
- StartHiding ->
- return ()
- EndHiding -> do
- Node.removeChild body elem
- Element.setClassName body ("" :: JSString)
- )
-
- R.performEvent_ $ void `fmap` showEffects
-
-data Action
- = Show
- | StartHiding
- | EndHiding
-
-getModalClass :: Action -> Text
-getModalClass Show = "g-Modal--Show"
-getModalClass StartHiding = "g-Modal--Hiding"
-getModalClass _ = ""
-
-isVisible :: Action -> Bool
-isVisible Show = True
-isVisible StartHiding = True
-isVisible EndHiding = False
diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
deleted file mode 100644
index c56ff88..0000000
--- a/client/src/Component/ModalForm.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-module Component.ModalForm
- ( view
- , In(..)
- , Out(..)
- ) where
-
-import Data.Aeson (ToJSON)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time.Calendar (Day)
-import Data.Validation (Validation)
-import qualified Data.Validation as V
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import qualified Common.Msg as Msg
-import qualified Component.Button as Button
-import qualified Component.Form as Form
-import qualified Util.Either as EitherUtil
-import qualified Util.Validation as ValidationUtil
-import qualified Util.WaitFor as WaitFor
-
-data In m t a e = In
- { _in_headerLabel :: Text
- , _in_form :: m (Dynamic t (Validation e a))
- , _in_ajax :: Event t a -> m (Event t (Either Text ()))
- }
-
-data Out t = Out
- { _out_hide :: Event t ()
- , _out_cancel :: Event t ()
- , _out_confirm :: Event t ()
- , _out_validate :: Event t ()
- }
-
-view :: forall t m a e. (MonadWidget t m, ToJSON a) => In m t a e -> m (Out t)
-view input =
- R.divClass "form" $ do
- R.divClass "formHeader" $
- R.text (_in_headerLabel input)
-
- Form.view $
- R.divClass "formContent" $ do
- rec
- form <- _in_form input
-
- (validate, cancel, confirm) <- R.divClass "buttons" $ do
- rec
- cancel <- Button._out_clic <$> (Button.view $
- (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
- { Button._in_class = R.constDyn "undo" })
-
- confirm <- Button._out_clic <$> (Button.view $
- (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
- { Button._in_class = R.constDyn "confirm"
- , Button._in_waiting = waiting
- , Button._in_submit = True
- })
-
- (validate, waiting) <- WaitFor.waitFor
- (_in_ajax input)
- (ValidationUtil.fireValidation form confirm)
-
- return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm)
-
- return Out
- { _out_hide = R.leftmost [ cancel, () <$ validate ]
- , _out_cancel = cancel
- , _out_confirm = confirm
- , _out_validate = validate
- }
diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs
deleted file mode 100644
index d54cd3d..0000000
--- a/client/src/Component/Pages.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-module Component.Pages
- ( view
- , In(..)
- , Out(..)
- ) where
-
-import qualified Data.Text as T
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import qualified Component.Button as Button
-
-import qualified Util.Reflex as ReflexUtil
-import qualified View.Icon as Icon
-
-data In t = In
- { _in_total :: Dynamic t Int
- , _in_perPage :: Int
- , _in_page :: Int
- }
-
-data Out t = Out
- { _out_newPage :: Event t Int
- }
-
-view :: forall t m. MonadWidget t m => In t -> m (Out t)
-view input = do
- newPage <- ReflexUtil.divVisibleIf ((> 0) <$> (_in_total input)) $ pageButtons input
-
- return $ Out
- { _out_newPage = newPage
- }
-
-pageButtons
- :: forall t m. MonadWidget t m
- => In t
- -> m (Event t Int)
-pageButtons input = do
- R.divClass "pages" $ do
- rec
- let newPage = R.leftmost
- [ firstPageClic
- , previousPageClic
- , pageClic
- , nextPageClic
- , lastPageClic
- ]
-
- currentPage <- R.holdDyn (_in_page input) newPage
-
- firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
-
- previousPageClic <- pageButton noCurrentPage (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
-
- pageClic <- pageEvent <$> (R.simpleList (range <$> currentPage <*> maxPage) $ \p ->
- pageButton (Just <$> currentPage) p (R.dynText $ fmap (T.pack . show) p))
-
- nextPageClic <- pageButton noCurrentPage ((\c m -> min (c + 1) m) <$> currentPage <*> maxPage) Icon.doubleRight
-
- lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
-
- return newPage
-
- where maxPage = R.ffor (_in_total input) (\t -> ceiling $ toRational t / toRational (_in_perPage input))
- pageEvent = R.switch . R.current . fmap R.leftmost
- noCurrentPage = R.constDyn Nothing
-
-range :: Int -> Int -> [Int]
-range currentPage maxPage = [start..end]
- where sidePages = 2
- start = max 1 (min (currentPage - sidePages) (maxPage - sidePages * 2))
- end = min maxPage (start + sidePages * 2)
-
-pageButton :: forall t m. MonadWidget t m => Dynamic t (Maybe Int) -> Dynamic t Int -> m () -> m (Event t Int)
-pageButton currentPage page content = do
- clic <- Button._out_clic <$> (Button.view $ Button.In
- { Button._in_class = do
- cp <- currentPage
- p <- page
- if cp == Just p then "page current" else "page"
- , Button._in_content = content
- , Button._in_waiting = R.never
- , Button._in_tabIndex = Nothing
- , Button._in_submit = False
- })
- return . fmap fst $ R.attach (R.current page) clic
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
deleted file mode 100644
index 70f5f58..0000000
--- a/client/src/Component/Select.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-module Component.Select
- ( view
- , In(..)
- , Out(..)
- ) where
-
-import Data.Map (Map)
-import qualified Data.Map as M
-import qualified Data.Maybe as Maybe
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Validation (Validation)
-import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
-import qualified Reflex.Dom as R
-
-import qualified Util.Validation as ValidationUtil
-
-data (Reflex t) => In t a b c = In
- { _in_label :: Text
- , _in_initialValue :: a
- , _in_value :: Event t a
- , _in_values :: Dynamic t (Map a Text)
- , _in_reset :: Event t b
- , _in_isValid :: a -> Validation Text a
- , _in_validate :: Event t c
- }
-
-data Out t a = Out
- { _out_raw :: Dynamic t a
- , _out_value :: Dynamic t (Validation Text a)
- }
-
-view :: forall t m a b c. (Ord a, MonadWidget t m) => In t a b c -> m (Out t a)
-view input = do
- rec
- let containerAttr = R.ffor showedError (\e ->
- M.singleton "class" $ T.intercalate " "
- [ "input selectInput"
- , if Maybe.isJust e then "error" else ""
- ])
-
- validatedValue =
- fmap (_in_isValid input) value
-
- maybeError =
- fmap ValidationUtil.maybeError validatedValue
-
- showedError <- R.holdDyn Nothing $ R.leftmost
- [ Nothing <$ _in_reset input
- , R.updated maybeError
- , R.attachWith const (R.current maybeError) (_in_validate input)
- ]
-
- value <- R.elDynAttr "div" containerAttr $ do
- let initialValue = _in_initialValue input
-
- let setValue = R.leftmost
- [ initialValue <$ (_in_reset input)
- , _in_value input
- ]
-
- value <- R.el "label" $ do
- R.divClass "label" $
- R.text (_in_label input)
-
- R._dropdown_value <$>
- R.dropdown
- initialValue
- (_in_values input)
- (R.def { R._dropdownConfig_setValue = setValue })
-
- R.divClass "errorMessage" . R.dynText $
- R.ffor showedError (Maybe.fromMaybe "")
-
- return value
-
- return Out
- { _out_raw = value
- , _out_value = validatedValue
- }
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
deleted file mode 100644
index 1482f91..0000000
--- a/client/src/Component/Table.hs
+++ /dev/null
@@ -1,105 +0,0 @@
-module Component.Table
- ( view
- , In(..)
- , Out(..)
- ) where
-
-import qualified Data.Map as M
-import Data.Text (Text)
-import Reflex.Dom (Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import qualified Component.Button as Button
-import qualified Component.Modal as Modal
-import qualified Util.Reflex as ReflexUtil
-import qualified View.Icon as Icon
-
-data In m t h r = In
- { _in_headerLabel :: h -> Text
- , _in_rows :: [r]
- , _in_cell :: h -> r -> m ()
- , _in_cloneModal :: r -> Modal.Content t m
- , _in_editModal :: r -> Modal.Content t m
- , _in_deleteModal :: r -> Modal.Content t m
- , _in_canEdit :: r -> Bool
- , _in_canDelete :: r -> Bool
- }
-
-data Out t = Out
- { _out_add :: Event t ()
- , _out_edit :: Event t ()
- , _out_delete :: Event t ()
- }
-
-view :: forall t m h r. (MonadWidget t m, Bounded h, Enum h) => In m t h r -> m (Out t)
-view input =
- R.divClass "table" $ do
- rec
- result <- R.divClass "lines" $ do
-
- R.divClass "header" $ do
- flip mapM_ [minBound..] $ \header ->
- R.divClass "cell" . R.text $
- _in_headerLabel input header
-
- R.divClass "cell" $ R.blank
- R.divClass "cell" $ R.blank
- R.divClass "cell" $ R.blank
-
- flip mapM (_in_rows input) $ \row ->
- R.divClass "row" $ do
- flip mapM_ [minBound..] $ \header ->
- R.divClass "cell" $
- _in_cell input header row
-
- cloneButton <-
- R.divClass "cell button" $
- Button._out_clic <$> (Button.view $
- Button.defaultIn Icon.clone)
-
- clone <-
- Modal.view $ Modal.In
- { Modal._in_show = cloneButton
- , Modal._in_content = _in_cloneModal input row
- }
-
- let visibleIf cond =
- R.elAttr
- "div"
- (if cond then M.empty else M.singleton "style" "display:none")
-
- editButton <-
- R.divClass "cell button" $
- visibleIf (_in_canEdit input row) $
- Button._out_clic <$> (Button.view $
- Button.defaultIn Icon.edit)
-
- edit <-
- Modal.view $ Modal.In
- { Modal._in_show = editButton
- , Modal._in_content = _in_editModal input row
- }
-
- deleteButton <-
- R.divClass "cell button" $
- visibleIf (_in_canDelete input row) $
- Button._out_clic <$> (Button.view $
- Button.defaultIn Icon.delete)
-
- delete <-
- Modal.view $ Modal.In
- { Modal._in_show = deleteButton
- , Modal._in_content = _in_deleteModal input row
- }
-
- return (clone, edit, delete)
-
- let add = R.leftmost . map (\(a, _, _) -> a) $ result
- edit = R.leftmost . map (\(_, a, _) -> a) $ result
- delete = R.leftmost . map (\(_, _, a) -> a) $ result
-
- return $ Out
- { _out_add = add
- , _out_edit = edit
- , _out_delete = delete
- }
diff --git a/client/src/Component/Tag.hs b/client/src/Component/Tag.hs
deleted file mode 100644
index f75b8d3..0000000
--- a/client/src/Component/Tag.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module Component.Tag
- ( In(..)
- , view
- ) where
-
-import qualified Data.Map as M
-import Data.Text (Text)
-import qualified Data.Text as T
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
-
-data In = In
- { _in_text :: Text
- , _in_color :: Text
- }
-
-view :: forall t m a. MonadWidget t m => In -> m ()
-view input =
- R.elAttr "span" attrs $
- R.text $ _in_text input
-
- where
- attrs =
- M.fromList
- [ ("class", "tag")
- , ("style", T.concat [ "background-color: ", _in_color input ])
- ]
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-01 09:50:30 +0000