From f968c8ce63e1aec119b1e6f414cf27e2c0294bcb Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 23 Oct 2019 21:09:54 +0200
Subject: Delete income

---
 client/src/Component/ConfirmDialog.hs | 49 +++++++++++++++++++++++++++++++++++
 client/src/Component/Table.hs         | 42 ++++++++++++++++++++++--------
 2 files changed, 80 insertions(+), 11 deletions(-)
 create mode 100644 client/src/Component/ConfirmDialog.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/ConfirmDialog.hs b/client/src/Component/ConfirmDialog.hs
new file mode 100644
index 0000000..50e30ed
--- /dev/null
+++ b/client/src/Component/ConfirmDialog.hs
@@ -0,0 +1,49 @@
+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 a = In
+  { _in_header  :: Text
+  , _in_confirm :: Event t () -> m (Event t a)
+  }
+
+view :: forall t m a. MonadWidget t m => (In t m a) -> Modal.Content t m a
+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/Table.hs b/client/src/Component/Table.hs
index 5819f45..b3c70a0 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -20,11 +20,14 @@ data In m t h r a = In
   , _in_cell        :: h -> r -> Text
   , _in_perPage     :: Int
   , _in_resetPage   :: Event t ()
-  , _in_cloneModal  :: Dynamic t r -> Modal.Content t m a
+  , _in_cloneModal  :: r -> Modal.Content t m a
+  , _in_deleteModal :: r -> Modal.Content t m a
+  , _in_isOwner     :: r -> Bool
   }
 
 data Out t a = Out
-  { _out_add :: Event t a
+  { _out_add    :: Event t a
+  , _out_delete :: Event t a
   }
 
 view :: forall t m h r a. (MonadWidget t m, Bounded h, Enum h)  => In m t h r a -> m (Out t a)
@@ -39,6 +42,7 @@ view input =
               _in_headerLabel input header
 
           R.divClass "cell" $ R.blank
+          R.divClass "cell" $ R.blank
 
         let rows = getRange
               (_in_perPage input)
@@ -60,25 +64,41 @@ view input =
             cloned <-
               Modal.view $ Modal.In
                 { Modal._in_show    = clone
-                , Modal._in_content = _in_cloneModal input r
+                , Modal._in_content = \curtainClick ->
+                  (R.dyn . R.ffor r $ \r2 -> _in_cloneModal input r2 curtainClick)
+                    >>= ReflexUtil.flattenTuple
+                }
+
+            let isOwner = R.ffor r (_in_isOwner input)
+
+            delete <-
+              R.divClass "cell button" $
+                ReflexUtil.divVisibleIf isOwner $
+                  Button._out_clic <$> (Button.view $
+                    Button.defaultIn Icon.delete)
+
+            deleted <-
+              Modal.view $ Modal.In
+                { Modal._in_show    = delete
+                , Modal._in_content = \curtainClick ->
+                  (R.dyn . R.ffor r $ \r2 -> _in_deleteModal input r2 curtainClick)
+                    >>= ReflexUtil.flattenTuple
                 }
 
-            return cloned
+            return (cloned, deleted)
 
       pages <- Pages.view $ Pages.In
-        { Pages._in_total = length <$> (_in_rows input)
+        { Pages._in_total = length <$> _in_rows input
         , Pages._in_perPage = _in_perPage input
         , Pages._in_reset = _in_resetPage input
         }
 
-      -- return $
-      --   ( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
-      --   , R.switch . R.current . fmap (R.leftmost . map (\(_, b, _) -> b)) $ result
-      --   , R.switch . R.current . fmap (R.leftmost . map (\(_, _, c) -> c)) $ result
-      --   )
+    let add = R.switch . R.current . fmap (R.leftmost . map fst) $ result
+        delete = R.switch . R.current . fmap (R.leftmost . map snd) $ result
 
     return $ Out
-      { _out_add = R.switch . R.current . fmap R.leftmost $ result
+      { _out_add = add
+      , _out_delete = delete
       }
 
 getRange :: forall a. Int -> Int -> [a] -> [a]
-- 
cgit v1.2.3