aboutsummaryrefslogtreecommitdiff
path: root/client/src
diff options
context:
space:
mode:
Diffstat (limited to 'client/src')
-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
7 files changed, 131 insertions, 108 deletions
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
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 00:10:57 +0000