From e4b32ce15f8c92f3b477d3f3d4d301ba08f9b5e3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 23 Oct 2019 22:35:27 +0200
Subject: Edit an income

---
 ISSUES.md                         |  4 +-
 client/client.cabal               |  2 +-
 client/src/Component/ModalForm.hs | 50 +++++++++++-----------
 client/src/Component/Table.hs     | 25 +++++++++--
 client/src/View/Income/Add.hs     | 42 ------------------
 client/src/View/Income/Form.hs    | 89 +++++++++++++++++++++++++++------------
 client/src/View/Income/Header.hs  |  7 +--
 client/src/View/Income/Income.hs  |  9 ++--
 client/src/View/Income/Table.hs   | 17 +++++---
 server/src/Controller/Income.hs   | 21 +++++----
 server/src/Persistence/Income.hs  | 31 ++++++++------
 11 files changed, 166 insertions(+), 131 deletions(-)
 delete mode 100644 client/src/View/Income/Add.hs

diff --git a/ISSUES.md b/ISSUES.md
index 0249eab..928dc7f 100644
--- a/ISSUES.md
+++ b/ISSUES.md
@@ -2,7 +2,7 @@
 
 ## Income view
 
-- Edit an income
+- Go to page 1 after adding an income
 
 ## Payment
 
@@ -23,6 +23,7 @@
 ## Bugs
 
 - Fix page flickering on loading
+- After modal close, it is still on the DOM, preventing any click
 
 # Additional features
 
@@ -40,6 +41,7 @@
 
 # Code
 
+- Do something with ModalForm and ConfirmDialog
 - remove client warning messages
 - Use BEM style
 - Move the CSS out from the index page
diff --git a/client/client.cabal b/client/client.cabal
index 6163ab0..9a212e8 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -51,6 +51,7 @@ Executable client
     Component.Input
     Component.Link
     Component.Modal
+    Component.ModalForm
     Component.Pages
     Component.Select
     Component.Table
@@ -68,7 +69,6 @@ Executable client
     View.App
     View.Header
     View.Icon
-    View.Income.Add
     View.Income.Form
     View.Income.Header
     View.Income.Income
diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
index ea53beb..f5bf287 100644
--- a/client/src/Component/ModalForm.hs
+++ b/client/src/Component/ModalForm.hs
@@ -15,6 +15,7 @@ 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
@@ -38,32 +39,33 @@ view input =
     R.divClass "formHeader" $
       R.text (_in_headerLabel input)
 
-    R.divClass "formContent" $ do
-      rec
-        form <- _in_form 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" })
+          (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
-                })
+              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)
+              (validate, waiting) <- WaitFor.waitFor
+                (_in_ajax input)
+                (ValidationUtil.fireValidation form confirm)
 
-          return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, 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
-        }
+        return Out
+          { _out_hide = R.leftmost [ cancel, () <$ validate ]
+          , _out_cancel = cancel
+          , _out_confirm = confirm
+          , _out_validate = validate
+          }
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index b3c70a0..a02eaa7 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -21,12 +21,14 @@ data In m t h r a = In
   , _in_perPage     :: Int
   , _in_resetPage   :: Event t ()
   , _in_cloneModal  :: r -> Modal.Content t m a
+  , _in_editModal   :: 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_edit   :: Event t a
   , _out_delete :: Event t a
   }
 
@@ -43,6 +45,7 @@ view input =
 
           R.divClass "cell" $ R.blank
           R.divClass "cell" $ R.blank
+          R.divClass "cell" $ R.blank
 
         let rows = getRange
               (_in_perPage input)
@@ -71,6 +74,20 @@ view input =
 
             let isOwner = R.ffor r (_in_isOwner input)
 
+            edit <-
+              R.divClass "cell button" $
+                ReflexUtil.divVisibleIf isOwner $
+                  Button._out_clic <$> (Button.view $
+                    Button.defaultIn Icon.edit)
+
+            edited <-
+              Modal.view $ Modal.In
+                { Modal._in_show    = edit
+                , Modal._in_content = \curtainClick ->
+                  (R.dyn . R.ffor r $ \r2 -> _in_editModal input r2 curtainClick)
+                    >>= ReflexUtil.flattenTuple
+                }
+
             delete <-
               R.divClass "cell button" $
                 ReflexUtil.divVisibleIf isOwner $
@@ -85,7 +102,7 @@ view input =
                     >>= ReflexUtil.flattenTuple
                 }
 
-            return (cloned, deleted)
+            return (cloned, edited, deleted)
 
       pages <- Pages.view $ Pages.In
         { Pages._in_total = length <$> _in_rows input
@@ -93,11 +110,13 @@ view input =
         , Pages._in_reset = _in_resetPage input
         }
 
-    let add = R.switch . R.current . fmap (R.leftmost . map fst) $ result
-        delete = R.switch . R.current . fmap (R.leftmost . map snd) $ result
+    let add = R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
+        edit = R.switch . R.current . fmap (R.leftmost . map (\(_, a, _) -> a)) $ result
+        delete = R.switch . R.current . fmap (R.leftmost . map (\(_, _, a) -> a)) $ result
 
     return $ Out
       { _out_add = add
+      , _out_edit = edit
       , _out_delete = delete
       }
 
diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs
deleted file mode 100644
index 7780d73..0000000
--- a/client/src/View/Income/Add.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-module View.Income.Add
-  ( view
-  , In(..)
-  ) where
-
-import           Control.Monad.IO.Class (liftIO)
-import qualified Data.Maybe             as Maybe
-import qualified Data.Text              as T
-import qualified Data.Time.Clock        as Time
-import           Reflex.Dom             (MonadWidget)
-
-import           Common.Model           (CreateIncomeForm (..), Income (..))
-import qualified Common.Msg             as Msg
-import qualified Common.Util.Time       as TimeUtil
-import qualified Component.Form
-import qualified Component.Modal        as Modal
-import qualified Util.Ajax              as Ajax
-import qualified View.Income.Form       as Form
-
-data In t = In
-  { _in_income :: Maybe Income
-  }
-
-view :: forall t m. MonadWidget t m => In t -> Modal.Content t m Income
-view input cancel = do
-
-  currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
-
-  let amount =
-        Maybe.fromMaybe "" ((T.pack . show . _income_amount) <$> (_in_income input))
-
-  form <-
-    Component.Form.view $ Form.view $ Form.In
-      { Form._in_cancel = cancel
-      , Form._in_headerLabel = Msg.get Msg.Income_AddLong
-      , Form._in_amount = amount
-      , Form._in_date = currentDay
-      , Form._in_mkPayload = CreateIncomeForm
-      , Form._in_ajax = Ajax.post
-      }
-
-  return (Form._out_hide form, Form._out_addIncome form)
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
index 917edf1..5f354a2 100644
--- a/client/src/View/Income/Form.hs
+++ b/client/src/View/Income/Form.hs
@@ -1,60 +1,59 @@
 module View.Income.Form
   ( view
   , In(..)
-  , Out(..)
+  , Operation(..)
   ) where
 
-import           Data.Aeson               (FromJSON, ToJSON)
+import           Control.Monad.IO.Class   (liftIO)
+import           Data.Aeson               (ToJSON)
+import qualified Data.Maybe               as Maybe
 import           Data.Text                (Text)
 import qualified Data.Text                as T
-import           Data.Time.Calendar       (Day)
 import qualified Data.Time.Calendar       as Calendar
+import qualified Data.Time.Clock          as Time
 import           Data.Validation          (Validation)
 import qualified Data.Validation          as V
 import           Reflex.Dom               (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom               as R
 
-import           Common.Model             (Income)
+import           Common.Model             (EditIncomeForm (..), Income (..))
 import qualified Common.Msg               as Msg
+import qualified Common.Util.Time         as TimeUtil
 import qualified Common.Validation.Income as IncomeValidation
 import qualified Component.Input          as Input
+import qualified Component.Modal          as Modal
 import qualified Component.ModalForm      as ModalForm
+import qualified Util.Ajax                as Ajax
 
-data In m t a = In
-  { _in_cancel      :: Event t ()
-  , _in_headerLabel :: Text
-  , _in_amount      :: Text
-  , _in_date        :: Day
-  , _in_mkPayload   :: Text -> Text -> a
-  , _in_ajax        :: Text -> Event t a -> m (Event t (Either Text Income))
+data In t a = In
+  { _in_operation :: Operation a
   }
 
-data Out t = Out
-  { _out_hide      :: Event t ()
-  , _out_addIncome :: Event t Income
-  }
+data Operation a
+  = New (Text -> Text -> a)
+  | Clone (Text -> Text -> a) Income
+  | Edit (Text -> Text -> a) Income
+
+view :: forall t m a. (MonadWidget t m, ToJSON a) => In t a -> Modal.Content t m Income
+view input cancel = do
 
-view :: forall t m a. (MonadWidget t m, ToJSON a) => In m t a -> m (Out t)
-view input = do
   rec
     let reset = R.leftmost
           [ "" <$ ModalForm._out_cancel modalForm
           , "" <$ ModalForm._out_validate modalForm
-          , "" <$ _in_cancel input
+          , "" <$ cancel
           ]
 
     modalForm <- ModalForm.view $ ModalForm.In
-      { ModalForm._in_headerLabel = _in_headerLabel input
-      , ModalForm._in_ajax        = _in_ajax input "/api/income"
+      { ModalForm._in_headerLabel = headerLabel
+      , ModalForm._in_ajax        = ajax "/api/income"
       , ModalForm._in_form        = form reset (ModalForm._out_confirm modalForm)
       }
 
-  return $ Out
-    { _out_hide = ModalForm._out_hide modalForm
-    , _out_addIncome = ModalForm._out_validate modalForm
-    }
+  return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm)
 
   where
+
     form
       :: Event t String
       -> Event t ()
@@ -63,13 +62,15 @@ view input = do
       amount <- Input._out_raw <$> (Input.view
         (Input.defaultIn
           { Input._in_label = Msg.get Msg.Income_Amount
-          , Input._in_initialValue = _in_amount input
+          , Input._in_initialValue = amount
           , Input._in_validation = IncomeValidation.amount
           })
-        (_in_amount input <$ reset)
+        (amount <$ reset)
         confirm)
 
-      let initialDate = T.pack . Calendar.showGregorian . _in_date $ input
+      currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
+
+      let initialDate = T.pack . Calendar.showGregorian $ date currentDay
 
       date <- Input._out_raw <$> (Input.view
         (Input.defaultIn
@@ -85,4 +86,36 @@ view input = do
       return $ do
         a <- amount
         d <- date
-        return . V.Success $ (_in_mkPayload input) a d
+        return . V.Success $ mkPayload a d
+
+    op = _in_operation input
+
+    amount =
+      case op of
+        New _          -> ""
+        Clone _ income -> T.pack . show . _income_amount $ income
+        Edit _ income  -> T.pack . show . _income_amount $ income
+
+    date currentDay =
+      case op of
+        New _         -> currentDay
+        Clone _ _     -> currentDay
+        Edit _ income -> _income_date income
+
+    ajax =
+      case op of
+        New _     -> Ajax.post
+        Clone _ _ -> Ajax.post
+        Edit _ _  -> Ajax.put
+
+    headerLabel =
+      case op of
+        New _     -> Msg.get Msg.Income_AddLong
+        Clone _ _ -> Msg.get Msg.Income_AddLong
+        Edit _ _  -> Msg.get Msg.Income_Edit
+
+    mkPayload =
+      case op of
+        New f     -> f
+        Clone f _ -> f
+        Edit f _  -> f
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index f17e774..182db33 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -11,7 +11,8 @@ import qualified Data.Time.Clock        as Clock
 import           Reflex.Dom             (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Currency, Income (..), User (..))
+import           Common.Model           (CreateIncomeForm (..), Currency,
+                                         Income (..), User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.View.Format     as Format
@@ -19,7 +20,7 @@ import qualified Common.View.Format     as Format
 import qualified Component.Button       as Button
 import qualified Component.Modal        as Modal
 import qualified Util.Date              as DateUtil
-import qualified View.Income.Add        as Add
+import qualified View.Income.Form       as Form
 import           View.Income.Init       (Init (..))
 
 data In t = In
@@ -72,7 +73,7 @@ view input =
 
       addIncome <- Modal.view $ Modal.In
         { Modal._in_show    = addIncome
-        , Modal._in_content = Add.view $ Add.In { Add._in_income = Nothing }
+        , Modal._in_content = Form.view $ Form.In { Form._in_operation = Form.New CreateIncomeForm }
         }
 
       return $ Out
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index 2784cac..90f1fde 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -50,6 +50,7 @@ view input = do
         incomes <- reduceIncomes
           (_init_incomes init)
           addIncome
+          (Table._out_edit table)
           (Table._out_delete table)
 
         header <- Header.view $ Header.In
@@ -72,11 +73,13 @@ view input = do
 reduceIncomes
   :: forall t m. MonadWidget t m
   => [Income]
-  -> Event t Income -- add income
-  -> Event t Income -- delete income
+  -> Event t Income -- add
+  -> Event t Income -- edit
+  -> Event t Income -- delete
   -> m (Dynamic t [Income])
-reduceIncomes initIncomes add delete =
+reduceIncomes initIncomes add edit delete =
   R.foldDyn id initIncomes $ R.leftmost
     [ (:) <$> add
+    , R.ffor edit (\p -> (p:) . filter ((/= (_income_id p)) . _income_id))
     , R.ffor delete (\p -> filter ((/= (_income_id p)) . _income_id))
     ]
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index 16ebf7c..f865fd9 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -11,8 +11,9 @@ import qualified Data.Text               as T
 import           Reflex.Dom              (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom              as R
 
-import           Common.Model            (Currency, Income (..), User (..),
-                                          UserId)
+import           Common.Model            (CreateIncomeForm (..), Currency,
+                                          EditIncomeForm (..), Income (..),
+                                          User (..), UserId)
 import qualified Common.Model            as CM
 import qualified Common.Msg              as Msg
 import qualified Common.View.Format      as Format
@@ -21,7 +22,7 @@ import qualified Component.ConfirmDialog as ConfirmDialog
 import qualified Component.Table         as Table
 import qualified Util.Ajax               as Ajax
 import qualified Util.Either             as EitherUtil
-import qualified View.Income.Add         as Add
+import qualified View.Income.Form        as Form
 import           View.Income.Init        (Init (..))
 
 data In t = In
@@ -33,6 +34,7 @@ data In t = In
 
 data Out t = Out
   { _out_add    :: Event t Income
+  , _out_edit   :: Event t Income
   , _out_delete :: Event t Income
   }
 
@@ -46,8 +48,12 @@ view input = do
     , Table._in_perPage = 7
     , Table._in_resetPage = R.never
     , Table._in_cloneModal = \income ->
-      Add.view $ Add.In
-        { Add._in_income = Just income
+      Form.view $ Form.In
+        { Form._in_operation = Form.Clone CreateIncomeForm income
+        }
+    , Table._in_editModal = \income ->
+      Form.view $ Form.In
+        { Form._in_operation = Form.Edit (EditIncomeForm $ _income_id income) income
         }
     , Table._in_deleteModal = \income ->
       ConfirmDialog.view $ ConfirmDialog.In
@@ -63,6 +69,7 @@ view input = do
 
   return $ Out
     { _out_add = Table._out_add table
+    , _out_edit = Table._out_edit table
     , _out_delete = Table._out_delete table
     }
 
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index b40976b..236e032 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -11,11 +11,12 @@ import qualified Network.HTTP.Types.Status as Status
 import           Web.Scotty                hiding (delete)
 
 import           Common.Model              (CreateIncomeForm (..),
-                                            EditIncome (..), IncomeId,
+                                            EditIncomeForm (..), IncomeId,
                                             User (..))
 
 import qualified Controller.Helper         as ControllerHelper
 import           Model.CreateIncome        (CreateIncome (..))
+import           Model.EditIncome          (EditIncome (..))
 import qualified Model.Query               as Query
 import qualified Persistence.Income        as IncomePersistence
 import qualified Secure
@@ -40,13 +41,17 @@ create form =
     ) >>= ControllerHelper.jsonOrBadRequest
   )
 
-edit :: EditIncome -> ActionM ()
-edit (EditIncome incomeId date amount) =
-  Secure.loggedAction (\user -> do
-    updated <- liftIO . Query.run $ IncomePersistence.edit (_user_id user) incomeId date amount
-    if updated
-      then status Status.ok200
-      else status Status.badRequest400
+edit :: EditIncomeForm -> ActionM ()
+edit form =
+  Secure.loggedAction (\user ->
+    (liftIO . Query.run $ do
+      case IncomeValidation.editIncome form of
+        Success (EditIncome incomeId amount date) -> do
+          Right <$> (IncomePersistence.edit (_user_id user) incomeId date amount)
+
+        Failure validationError ->
+          return $ Left validationError
+    ) >>= ControllerHelper.jsonOrBadRequest
   )
 
 delete :: IncomeId -> ActionM ()
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index a0c3bbf..2b9bf0c 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -56,25 +56,30 @@ create userId date amount =
       }
   )
 
-edit :: UserId -> IncomeId -> Day -> Int -> Query Bool
-edit incomeUserId incomeId incomeDate incomeAmount =
+edit :: UserId -> IncomeId -> Day -> Int -> Query (Maybe Income)
+edit userId incomeId incomeDate incomeAmount =
   Query (\conn -> do
     mbIncome <- fmap (\(Row i) -> i) . listToMaybe <$>
       SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
     case mbIncome of
       Just income ->
-        if _income_userId income == incomeUserId
-          then do
-            now <- getCurrentTime
-            SQLite.execute
-              conn
-              "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ?"
-              (now, incomeDate, incomeAmount, incomeId)
-            return True
-          else
-            return False
+        do
+          currentTime <- getCurrentTime
+          SQLite.execute
+            conn
+            "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ? AND user_id = ?"
+            (currentTime, incomeDate, incomeAmount, incomeId, userId)
+          return . Just $ Income
+            { _income_id        = incomeId
+            , _income_userId    = userId
+            , _income_date      = incomeDate
+            , _income_amount    = incomeAmount
+            , _income_createdAt = _income_createdAt income
+            , _income_editedAt  = Just currentTime
+            , _income_deletedAt = Nothing
+            }
       Nothing ->
-        return False
+        return Nothing
   )
 
 delete :: UserId -> PaymentId -> Query ()
-- 
cgit v1.2.3