Commit 122ae281 authored by Joris's avatar Joris

Delete income

parent 61ff1443
# MVP
## Income view
- Edit an income
- Remove an income
## Payment
......@@ -15,10 +16,14 @@
- Edit a category
- Remove a category
## Slow
## Low speed
- Implement server side paging
## Bugs
- Fix page flickering on loading
# Additional features
- Remove unused payment category after payment edit on frontend
......
......@@ -46,6 +46,7 @@ Executable client
other-modules:
Component.Button
Component.ConfirmDialog
Component.Form
Component.Input
Component.Link
......
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
)
......@@ -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]
......
......@@ -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
......
......@@ -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
}
......
......@@ -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)
module View.Income.Delete
( In(..)
, view
) where
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 (Income (..))
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
data In t = In
{ _in_payment :: Dynamic t Income
}
view :: forall t m. MonadWidget t m => (In t) -> Modal.Content t m Income
view input _ =
R.divClass "delete" $ do
R.divClass "deleteHeader" $ R.text $ Msg.get Msg.Payment_DeleteConfirm
R.divClass "deleteContent" $ 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
})
let url =
R.ffor (_in_payment input) (\id ->
T.concat ["/api/income/", T.pack . show $ _payment_id id]
)
(result, waiting) <- WaitFor.waitFor
(Ajax.delete url)
confirm
return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
return $
( R.leftmost [ cancel, () <$ confirm ]
, R.tag (R.current $ _in_payment input) confirm
)
......@@ -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
......
......@@ -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))
]
......@@ -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
......
......@@ -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
......
......@@ -74,6 +74,7 @@ Executable server
Design.Media
Design.Modal
Design.Tooltip
Design.View.ConfirmDialog
Design.View.Header
Design.View.NotFound
Design.View.Pages
......
module Design.View.ConfirmDialog
( design
) where
import Clay
import qualified Design.Color as Color
import qualified Design.Constants as Constants
import qualified Design.Helper as Helper
design :: Css
design = do
".confirm" ? do
".confirmHeader" ? do
backgroundColor Color.chestnutRose
fontSize (px 18)
color Color.white
sym padding (px 20)
textAlign (alignSide sideCenter)
borderRadius (px 5) (px 5) (px 0) (px 0)
".confirmContent" ? do
sym padding (px 20)
".buttons" ? do
display flex
justifyContent spaceAround
marginTop (em 1.5)
".confirm" ?
Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
".undo" ?
Helper.button Color.silver Color.white (px Constants.inputHeight) Constants.focusLighten
(".confirm" <> ".undo") ?
width (px 90)
......@@ -4,17 +4,18 @@ module Design.Views
import Clay
import qualified Design.Color as Color
import qualified Design.Constants as Constants
import qualified Design.Helper as Helper
import qualified Design.Media as Media
import qualified Design.View.Header as Header
import qualified Design.View.NotFound as NotFound
import qualified Design.View.Pages as Pages
import qualified Design.View.Payment as Payment
import qualified Design.View.SignIn as SignIn
import qualified Design.View.Stat as Stat
import qualified Design.View.Table as Table
import qualified Design.Color as Color
import qualified Design.Constants as Constants
import qualified Design.Helper as Helper
import qualified Design.Media as Media
import qualified Design.View.ConfirmDialog as ConfirmDialog
import qualified Design.View.Header as Header
import qualified Design.View.NotFound as NotFound
import qualified Design.View.Pages as Pages
import qualified Design.View.Payment as Payment
import qualified Design.View.SignIn as SignIn
import qualified Design.View.Stat as Stat
import qualified Design.View.Table as Table
design :: Css
design = do
......@@ -25,6 +26,7 @@ design = do
".notfound" ? NotFound.design
Table.design
Pages.design
ConfirmDialog.design
".withMargin" ? do
"margin" -: "0 2vw"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment