aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ISSUES.md4
-rw-r--r--client/client.cabal2
-rw-r--r--client/src/Component/ModalForm.hs50
-rw-r--r--client/src/Component/Table.hs25
-rw-r--r--client/src/View/Income/Add.hs42
-rw-r--r--client/src/View/Income/Form.hs89
-rw-r--r--client/src/View/Income/Header.hs7
-rw-r--r--client/src/View/Income/Income.hs9
-rw-r--r--client/src/View/Income/Table.hs17
-rw-r--r--server/src/Controller/Income.hs21
-rw-r--r--server/src/Persistence/Income.hs31
11 files changed, 166 insertions, 131 deletions
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 ()
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 13:15:58 +0000