diff options
Diffstat (limited to 'client/src/Component/Table.hs')
-rw-r--r-- | client/src/Component/Table.hs | 105 |
1 files changed, 105 insertions, 0 deletions
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs new file mode 100644 index 0000000..1482f91 --- /dev/null +++ b/client/src/Component/Table.hs @@ -0,0 +1,105 @@ +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 + } |