aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ISSUES.md9
-rw-r--r--client/src/Component/Table.hs54
-rw-r--r--client/src/View/Income/Add.hs20
-rw-r--r--client/src/View/Income/Header.hs2
-rw-r--r--client/src/View/Income/Income.hs17
-rw-r--r--client/src/View/Income/Table.hs32
-rw-r--r--client/src/View/Payment/Clone.hs6
-rw-r--r--server/src/Design/View/Payment/Table.hs5
-rw-r--r--server/src/Design/View/Table.hs3
9 files changed, 99 insertions, 49 deletions
diff --git a/ISSUES.md b/ISSUES.md
index 95b435a..db60794 100644
--- a/ISSUES.md
+++ b/ISSUES.md
@@ -1,9 +1,12 @@
## Income view
-- Clone an income
- Edit an income
- Remove an income
+## Payment
+
+- Use income table factorizations
+
## Category view
- Show the category table
@@ -12,9 +15,9 @@
- Edit a category
- Remove a category
-## Mobile
+## Slow
-- Slow, consider native ? consider doing more work on the server ?
+- Implement server side paging
# Additional features
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index bf76566..5819f45 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -4,56 +4,82 @@ module Component.Table
, Out(..)
) where
-import Data.Text (Text)
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
+import Data.Text (Text)
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
-import qualified Component.Pages as Pages
+import qualified Component.Button as Button
+import qualified Component.Modal as Modal
+import qualified Component.Pages as Pages
+import qualified Util.Reflex as ReflexUtil
+import qualified View.Icon as Icon
-data In h r t = In
+data In m t h r a = In
{ _in_headerLabel :: h -> Text
, _in_rows :: Dynamic t [r]
, _in_cell :: h -> r -> Text
, _in_perPage :: Int
, _in_resetPage :: Event t ()
+ , _in_cloneModal :: Dynamic t r -> Modal.Content t m a
}
-data Out = Out
- {}
+data Out t a = Out
+ { _out_add :: Event t a
+ }
-view :: forall t m h r. (MonadWidget t m, Bounded h, Enum h) => In h r t -> m (Out)
+view :: forall t m h r a. (MonadWidget t m, Bounded h, Enum h) => In m t h r a -> m (Out t a)
view input =
R.divClass "table" $ do
rec
- R.divClass "lines" $ do
+ result <- R.divClass "lines" $ do
- R.divClass "header" $
+ R.divClass "header" $ do
flip mapM_ [minBound..] $ \header ->
R.divClass "cell" . R.text $
_in_headerLabel input header
+ R.divClass "cell" $ R.blank
+
let rows = getRange
(_in_perPage input)
<$> (Pages._out_currentPage pages)
<*> (_in_rows input)
R.simpleList rows $ \r ->
- R.divClass "row" $
+ R.divClass "row" $ do
flip mapM_ [minBound..] $ \h ->
- R.divClass "cell name" $
+ R.divClass "cell" $
R.dynText $
R.ffor r (_in_cell input h)
+ clone <-
+ R.divClass "cell button" $
+ Button._out_clic <$> (Button.view $
+ Button.defaultIn Icon.clone)
+
+ cloned <-
+ Modal.view $ Modal.In
+ { Modal._in_show = clone
+ , Modal._in_content = _in_cloneModal input r
+ }
+
+ return cloned
+
pages <- Pages.view $ Pages.In
{ Pages._in_total = length <$> (_in_rows input)
, Pages._in_perPage = _in_perPage input
, Pages._in_reset = _in_resetPage input
}
- return ()
+ -- 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
+ -- )
return $ Out
- {}
+ { _out_add = R.switch . R.current . fmap R.leftmost $ result
+ }
getRange :: forall a. Int -> Int -> [a] -> [a]
getRange perPage currentPage =
diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs
index f8f107f..d07bd45 100644
--- a/client/src/View/Income/Add.hs
+++ b/client/src/View/Income/Add.hs
@@ -1,13 +1,16 @@
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 Reflex.Dom (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (CreateIncomeForm (..), Income)
+import Common.Model (CreateIncomeForm (..), Income (..))
import qualified Common.Msg as Msg
import qualified Common.Util.Time as TimeUtil
import qualified Component.Modal as Modal
@@ -15,16 +18,21 @@ import qualified Util.Ajax as Ajax
import qualified Util.Reflex as ReflexUtil
import qualified View.Income.Form as Form
-view :: forall t m. MonadWidget t m => Modal.Content t m Income
-view cancel = do
+data In t = In
+ { _in_income :: Dynamic t (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
- form <- R.dyn $
+ form <- R.dyn $ do
+ income <- _in_income input
return $ Form.view $ Form.In
{ Form._in_cancel = cancel
, Form._in_headerLabel = Msg.get Msg.Income_AddLong
- , Form._in_amount = ""
+ , Form._in_amount = Maybe.fromMaybe "" ((T.pack . show . _income_amount) <$> income)
, Form._in_date = currentDay
, Form._in_mkPayload = CreateIncomeForm
, Form._in_ajax = Ajax.post
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index ae1174a..0360d1f 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -72,7 +72,7 @@ view input =
addIncome <- Modal.view $ Modal.In
{ Modal._in_show = addIncome
- , Modal._in_content = Add.view
+ , Modal._in_content = Add.view $ Add.In { Add._in_income = R.constDyn Nothing }
}
return $ Out
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index f8359bb..b97613d 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -41,11 +41,14 @@ view input = do
R.elClass "main" "income" $ do
rec
-
+ let addIncome = R.leftmost
+ [ Header._out_addIncome header
+ , Table._out_addIncome table
+ ]
incomes <- R.foldDyn
(:)
(_init_incomes init)
- (Header._out_addIncome header)
+ addIncome
header <- Header.view $ Header.In
{ Header._in_init = init
@@ -53,11 +56,11 @@ view input = do
, Header._in_incomes = incomes
}
- Table.view $ Table.In
- { Table._in_init = init
- , Table._in_currency = _in_currency input
- , Table._in_incomes = incomes
- }
+ table <- Table.view $ Table.In
+ { Table._in_init = init
+ , Table._in_currency = _in_currency input
+ , Table._in_incomes = incomes
+ }
return ()
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index 9cb705f..358cb17 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -1,12 +1,13 @@
module View.Income.Table
( view
, In(..)
+ , Out(..)
) where
import qualified Data.List as L
import qualified Data.Maybe as Maybe
import Data.Text (Text)
-import Reflex.Dom (Dynamic, MonadWidget)
+import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Currency, Income (..), User (..))
@@ -15,6 +16,7 @@ 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 (..))
data In t = In
@@ -23,18 +25,28 @@ data In t = In
, _in_incomes :: Dynamic t [Income]
}
-view :: forall t m. MonadWidget t m => In t -> m ()
+data Out t = Out
+ { _out_addIncome :: Event t Income
+ }
+
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
view input = do
- Table.view $ Table.In
- { Table._in_headerLabel = headerLabel
- , Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date
- , Table._in_cell = cell (_in_init input) (_in_currency input)
- , Table._in_perPage = 7
- , Table._in_resetPage = R.never
- }
+ table <- Table.view $ Table.In
+ { Table._in_headerLabel = headerLabel
+ , Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date
+ , Table._in_cell = cell (_in_init input) (_in_currency input)
+ , Table._in_perPage = 7
+ , Table._in_resetPage = R.never
+ , Table._in_cloneModal = \income ->
+ Add.view $ Add.In
+ { Add._in_income = Just <$> income
+ }
+ }
- return ()
+ return $ Out
+ { _out_addIncome = Table._out_add table
+ }
data Header
= UserHeader
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 56a33d9..82b0c27 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -34,7 +34,7 @@ view input cancel = do
currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
- formOutput <- R.dyn $ do
+ form <- R.dyn $ do
paymentCategories <- _in_paymentCategories input
payment <- _in_payment input
category <- _in_category input
@@ -52,8 +52,8 @@ view input cancel = do
, Form._in_ajax = Ajax.post
}
- hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
- clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> formOutput)
+ hide <- ReflexUtil.flatten (Form._output_hide <$> form)
+ clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> form)
return $
( hide
diff --git a/server/src/Design/View/Payment/Table.hs b/server/src/Design/View/Payment/Table.hs
index 26dc9ed..67828c9 100644
--- a/server/src/Design/View/Payment/Table.hs
+++ b/server/src/Design/View/Payment/Table.hs
@@ -4,7 +4,6 @@ module Design.View.Payment.Table
import Clay
-import qualified Design.Color as Color
import qualified Design.Media as Media
design :: Css
@@ -34,7 +33,3 @@ design = do
".shortDate" ? display none
".longDate" ? display inline
marginBottom (em 0.5)
-
- ".button" & svg ? do
- "path" ? ("fill" -: Color.toString Color.chestnutRose)
- width (px 18)
diff --git a/server/src/Design/View/Table.hs b/server/src/Design/View/Table.hs
index cd406fc..1c4e806 100644
--- a/server/src/Design/View/Table.hs
+++ b/server/src/Design/View/Table.hs
@@ -72,6 +72,9 @@ design = do
textAlign (alignSide sideCenter)
button ? do
padding (px 10) (px 10) (px 10) (px 10)
+ svg ? do
+ "path" ? ("fill" -: Color.toString Color.chestnutRose)
+ width (px 18)
hover & "svg path" ? do
"fill" -: "rgb(237, 122, 116)"
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-03 10:07:23 +0000