aboutsummaryrefslogtreecommitdiff
path: root/client/src
diff options
context:
space:
mode:
Diffstat (limited to 'client/src')
-rw-r--r--client/src/Component/ConfirmDialog.hs49
-rw-r--r--client/src/Component/Table.hs42
-rw-r--r--client/src/Util/Reflex.hs8
-rw-r--r--client/src/View/App.hs3
-rw-r--r--client/src/View/Income/Add.hs22
-rw-r--r--client/src/View/Income/Header.hs6
-rw-r--r--client/src/View/Income/Income.hs33
-rw-r--r--client/src/View/Income/Table.hs54
-rw-r--r--client/src/View/Payment/Delete.hs1
9 files changed, 163 insertions, 55 deletions
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]
diff --git a/client/src/Util/Reflex.hs b/client/src/Util/Reflex.hs
index c14feeb..9f51c5c 100644
--- a/client/src/Util/Reflex.hs
+++ b/client/src/Util/Reflex.hs
@@ -4,6 +4,7 @@ module Util.Reflex
, divVisibleIf
, divClassVisibleIf
, flatten
+ , flattenTuple
, getBody
) where
@@ -44,6 +45,13 @@ flatten e = do
dyn <- R.holdDyn R.never e
return $ R.switchDyn dyn
+
+flattenTuple
+ :: forall t m a b. MonadWidget t m
+ => Event t (Event t a, Event t b)
+ -> m (Event t a, Event t b)
+flattenTuple e = (,) <$> (flatten $ fmap fst e) <*> (flatten $ fmap snd e)
+
getBody :: forall t m. MonadWidget t m => m Element
getBody = do
document <- Dom.currentDocumentUnchecked
diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index e0a52e2..1e26417 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -69,7 +69,8 @@ signedWidget init route = do
IncomeRoute -> do
incomeInit <- Income.init
Income.view $ Income.In
- { Income._in_currency = _init_currency init
+ { Income._in_currentUser = _init_currentUser init
+ , Income._in_currency = _init_currency init
, Income._in_init = incomeInit
}
diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs
index d07bd45..7780d73 100644
--- a/client/src/View/Income/Add.hs
+++ b/client/src/View/Income/Add.hs
@@ -7,19 +7,18 @@ 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 (Dynamic, MonadWidget)
-import qualified Reflex.Dom as R
+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 Util.Reflex as ReflexUtil
import qualified View.Income.Form as Form
data In t = In
- { _in_income :: Dynamic t (Maybe Income)
+ { _in_income :: Maybe Income
}
view :: forall t m. MonadWidget t m => In t -> Modal.Content t m Income
@@ -27,18 +26,17 @@ view input cancel = do
currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
- form <- R.dyn $ do
- income <- _in_income input
- return $ Form.view $ Form.In
+ 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 = Maybe.fromMaybe "" ((T.pack . show . _income_amount) <$> income)
+ , Form._in_amount = amount
, Form._in_date = currentDay
, Form._in_mkPayload = CreateIncomeForm
, Form._in_ajax = Ajax.post
}
- hide <- ReflexUtil.flatten (Form._out_hide <$> form)
- addIncome <- ReflexUtil.flatten (Form._out_addIncome <$> form)
-
- return (hide, addIncome)
+ return (Form._out_hide form, Form._out_addIncome form)
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index 0360d1f..f17e774 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -29,7 +29,7 @@ data In t = In
}
data Out t = Out
- { _out_addIncome :: Event t Income
+ { _out_add :: Event t Income
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
@@ -72,11 +72,11 @@ view input =
addIncome <- Modal.view $ Modal.In
{ Modal._in_show = addIncome
- , Modal._in_content = Add.view $ Add.In { Add._in_income = R.constDyn Nothing }
+ , Modal._in_content = Add.view $ Add.In { Add._in_income = Nothing }
}
return $ Out
- { _out_addIncome = addIncome
+ { _out_add = addIncome
}
where
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index b97613d..2784cac 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -6,10 +6,10 @@ module View.Income.Income
import Data.Aeson (FromJSON)
import Prelude hiding (init)
-import Reflex.Dom (Dynamic, MonadWidget)
+import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Currency)
+import Common.Model (Currency, Income (..), UserId)
import Loadable (Loadable (..))
import qualified Loadable
@@ -19,8 +19,9 @@ import View.Income.Init (Init (..))
import qualified View.Income.Table as Table
data In t = In
- { _in_currency :: Currency
- , _in_init :: Dynamic t (Loadable Init)
+ { _in_currentUser :: UserId
+ , _in_currency :: Currency
+ , _in_init :: Dynamic t (Loadable Init)
}
init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init))
@@ -42,13 +43,14 @@ view input = do
rec
let addIncome = R.leftmost
- [ Header._out_addIncome header
- , Table._out_addIncome table
+ [ Header._out_add header
+ , Table._out_add table
]
- incomes <- R.foldDyn
- (:)
+
+ incomes <- reduceIncomes
(_init_incomes init)
addIncome
+ (Table._out_delete table)
header <- Header.view $ Header.In
{ Header._in_init = init
@@ -57,7 +59,8 @@ view input = do
}
table <- Table.view $ Table.In
- { Table._in_init = init
+ { Table._in_currentUser = _in_currentUser input
+ , Table._in_init = init
, Table._in_currency = _in_currency input
, Table._in_incomes = incomes
}
@@ -65,3 +68,15 @@ view input = do
return ()
return ()
+
+reduceIncomes
+ :: forall t m. MonadWidget t m
+ => [Income]
+ -> Event t Income -- add income
+ -> Event t Income -- delete income
+ -> m (Dynamic t [Income])
+reduceIncomes initIncomes add delete =
+ R.foldDyn id initIncomes $ R.leftmost
+ [ (:) <$> add
+ , 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 358cb17..16ebf7c 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -4,29 +4,36 @@ module View.Income.Table
, Out(..)
) where
-import qualified Data.List as L
-import qualified Data.Maybe as Maybe
-import Data.Text (Text)
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.List as L
+import qualified Data.Maybe as Maybe
+import Data.Text (Text)
+import qualified Data.Text as T
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
-import Common.Model (Currency, Income (..), User (..))
-import qualified Common.Model as CM
-import qualified Common.Msg as Msg
-import qualified Common.View.Format as Format
+import Common.Model (Currency, Income (..), User (..),
+ UserId)
+import qualified Common.Model as CM
+import qualified Common.Msg as Msg
+import qualified Common.View.Format as Format
-import qualified Component.Table as Table
-import qualified View.Income.Add as Add
-import View.Income.Init (Init (..))
+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 View.Income.Init (Init (..))
data In t = In
- { _in_init :: Init
- , _in_currency :: Currency
- , _in_incomes :: Dynamic t [Income]
+ { _in_currentUser :: UserId
+ , _in_init :: Init
+ , _in_currency :: Currency
+ , _in_incomes :: Dynamic t [Income]
}
data Out t = Out
- { _out_addIncome :: Event t Income
+ { _out_add :: Event t Income
+ , _out_delete :: Event t Income
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
@@ -40,12 +47,23 @@ view input = do
, Table._in_resetPage = R.never
, Table._in_cloneModal = \income ->
Add.view $ Add.In
- { Add._in_income = Just <$> income
+ { Add._in_income = Just income
}
+ , Table._in_deleteModal = \income ->
+ ConfirmDialog.view $ ConfirmDialog.In
+ { ConfirmDialog._in_header = Msg.get Msg.Income_DeleteConfirm
+ , ConfirmDialog._in_confirm = \e -> do
+ res <- Ajax.delete
+ (R.constDyn $ T.concat ["/api/income/", T.pack . show $ _income_id income])
+ e
+ return $ income <$ R.fmapMaybe EitherUtil.eitherToMaybe res
+ }
+ , Table._in_isOwner = (== (_in_currentUser input)) . _income_userId
}
return $ Out
- { _out_addIncome = Table._out_add table
+ { _out_add = Table._out_add table
+ , _out_delete = Table._out_delete table
}
data Header
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 471463c..e5e7219 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -12,7 +12,6 @@ import Common.Model (Payment (..))
import qualified Common.Msg as Msg
import qualified Component.Button as Button
import qualified Component.Modal as Modal
-import qualified Component.Modal as Modal
import qualified Util.Ajax as Ajax
import qualified Util.Either as EitherUtil
import qualified Util.WaitFor as WaitFor
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 00:37:12 +0000