aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ISSUES.md4
-rw-r--r--client/client.cabal4
-rw-r--r--client/src/Component.hs1
-rw-r--r--client/src/Component/Table.hs38
-rw-r--r--client/src/View/App.hs40
-rw-r--r--client/src/View/Income/Income.hs68
-rw-r--r--client/src/View/Payment/Payment.hs (renamed from client/src/View/Payment.hs)8
-rw-r--r--client/src/View/Payment/Table.hs3
-rw-r--r--common/src/Common/Message/Key.hs1
-rw-r--r--common/src/Common/Message/Translation.hs9
10 files changed, 147 insertions, 29 deletions
diff --git a/ISSUES.md b/ISSUES.md
index 92e9052..fbbcc87 100644
--- a/ISSUES.md
+++ b/ISSUES.md
@@ -1,7 +1,8 @@
## Income view
-- Show the income table
+- Show the income header
- Add an income
+- Clone an income
- Edit an income
- Remove an income
@@ -9,6 +10,7 @@
- Show the category table
- Add a category
+- Clone a category
- Edit a category
- Remove a category
diff --git a/client/client.cabal b/client/client.cabal
index 55ba5e1..f8fe1e1 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -50,6 +50,7 @@ Executable client
Component.Input
Component.Link
Component.Modal
+ Component.Table
Component.Select
Icon
Util.Ajax
@@ -62,8 +63,8 @@ Executable client
Util.WaitFor
View.App
View.Header
+ View.Income.Income
View.NotFound
- View.Payment
View.Payment.Add
View.Payment.Clone
View.Payment.Delete
@@ -71,5 +72,6 @@ Executable client
View.Payment.Form
View.Payment.Header
View.Payment.Pages
+ View.Payment.Payment
View.Payment.Table
View.SignIn
diff --git a/client/src/Component.hs b/client/src/Component.hs
index 7e0b151..97c250e 100644
--- a/client/src/Component.hs
+++ b/client/src/Component.hs
@@ -6,3 +6,4 @@ import Component.Input as X
import Component.Link as X
import Component.Modal as X
import Component.Select as X
+import Component.Table as X
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
new file mode 100644
index 0000000..a77a18d
--- /dev/null
+++ b/client/src/Component/Table.hs
@@ -0,0 +1,38 @@
+module Component.Table
+ ( table
+ , TableIn(..)
+ , TableOut(..)
+ ) where
+
+import Data.Text (Text)
+import Reflex.Dom (Dynamic, MonadWidget)
+import qualified Reflex.Dom as R
+
+data TableIn h r t = TableIn
+ { _tableIn_headerLabel :: h -> Text
+ , _tableIn_rows :: Dynamic t [r]
+ , _tableIn_cell :: h -> r -> Text
+ }
+
+data TableOut = TableOut
+ {}
+
+table :: forall t m h r. (MonadWidget t m, Bounded h, Enum h) => TableIn h r t -> m (TableOut)
+table tableIn = do
+ R.divClass "table" $ do
+
+ R.divClass "lines" $ do
+ R.divClass "header" $ do
+ flip mapM_ [minBound..] $ \header ->
+ R.divClass "cell" . R.text $
+ _tableIn_headerLabel tableIn header
+
+ R.simpleList (_tableIn_rows tableIn) $ \r ->
+ R.divClass "row" $
+ flip mapM_ [minBound..] $ \h ->
+ R.divClass "cell name" $
+ R.dynText $
+ R.ffor r (_tableIn_cell tableIn h)
+
+ return $ TableOut
+ {}
diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index d853c7e..3292336 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -2,22 +2,24 @@ module View.App
( widget
) where
-import qualified Data.Text as T
-import Prelude hiding (error, init)
-import Reflex.Dom (Dynamic, MonadWidget)
-import qualified Reflex.Dom as R
-
-import Common.Model (Init, InitResult (..))
-import qualified Common.Msg as Msg
-
-import Model.Route (Route (..))
-import qualified Util.Router as Router
-import View.Header (HeaderIn (..))
-import qualified View.Header as Header
-import qualified View.NotFound as NotFound
-import View.Payment (PaymentIn (..))
-import qualified View.Payment as Payment
-import qualified View.SignIn as SignIn
+import qualified Data.Text as T
+import Prelude hiding (error, init)
+import Reflex.Dom (Dynamic, MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Init, InitResult (..))
+import qualified Common.Msg as Msg
+
+import Model.Route (Route (..))
+import qualified Util.Router as Router
+import View.Header (HeaderIn (..))
+import qualified View.Header as Header
+import View.Income.Income (IncomeIn (..))
+import qualified View.Income.Income as Income
+import qualified View.NotFound as NotFound
+import View.Payment.Payment (PaymentIn (..))
+import qualified View.Payment.Payment as Payment
+import qualified View.SignIn as SignIn
widget :: InitResult -> IO ()
widget initResult =
@@ -59,12 +61,14 @@ signedWidget :: MonadWidget t m => Init -> Dynamic t Route -> m ()
signedWidget init route = do
R.dyn . R.ffor route $ \case
RootRoute ->
- Payment.widget $ PaymentIn
+ Payment.view $ PaymentIn
{ _paymentIn_init = init
}
IncomeRoute ->
- R.el "div" $ R.text "Incomes"
+ Income.view $ IncomeIn
+ { _incomeIn_init = init
+ }
NotFoundRoute ->
NotFound.view
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
new file mode 100644
index 0000000..5e9ce1d
--- /dev/null
+++ b/client/src/View/Income/Income.hs
@@ -0,0 +1,68 @@
+module View.Income.Income
+ ( view
+ , IncomeIn(..)
+ ) where
+
+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 (MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Income (..), Init (..), User (..))
+import qualified Common.Model as CM
+import qualified Common.Msg as Msg
+import qualified Common.View.Format as Format
+import Component (TableIn (..))
+import qualified Component
+
+data IncomeIn = IncomeIn
+ { _incomeIn_init :: Init
+ }
+
+view :: forall t m. MonadWidget t m => IncomeIn -> m ()
+view incomeIn =
+ R.elClass "main" "income" $ do
+
+ R.divClass "withMargin" $
+ R.divClass "titleButton" $
+ R.el "h1" $
+ R.text $
+ Msg.get Msg.Income_MonthlyNet
+
+ Component.table $ TableIn
+ { _tableIn_headerLabel = headerLabel
+ , _tableIn_rows =
+ R.constDyn
+ . reverse
+ . L.sortOn _income_date
+ . _init_incomes
+ . _incomeIn_init
+ $ incomeIn
+ , _tableIn_cell = cell (_incomeIn_init incomeIn)
+ }
+ return ()
+
+data Header
+ = UserHeader
+ | AmountHeader
+ | DateHeader
+ deriving (Eq, Show, Bounded, Enum)
+
+headerLabel :: Header -> Text
+headerLabel UserHeader = Msg.get Msg.Income_Name
+headerLabel DateHeader = Msg.get Msg.Income_Date
+headerLabel AmountHeader = Msg.get Msg.Income_Amount
+
+cell :: Init -> Header -> Income -> Text
+cell init header income =
+ case header of
+ UserHeader ->
+ Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) (_init_users init)
+
+ DateHeader ->
+ Format.longDay . _income_date $ income
+
+ AmountHeader ->
+ Format.price (_init_currency init) . _income_amount $ income
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment/Payment.hs
index 1072a5e..cfdb441 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -1,5 +1,5 @@
-module View.Payment
- ( widget
+module View.Payment.Payment
+ ( view
, PaymentIn(..)
) where
@@ -25,8 +25,8 @@ data PaymentIn = PaymentIn
{ _paymentIn_init :: Init
}
-widget :: forall t m. MonadWidget t m => PaymentIn -> m ()
-widget paymentIn = do
+view :: forall t m. MonadWidget t m => PaymentIn -> m ()
+view paymentIn = do
R.elClass "main" "payment" $ do
rec
let init = _paymentIn_init paymentIn
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 40bc864..bf6b604 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -30,9 +30,6 @@ import qualified View.Payment.Edit as Edit
import qualified Icon
import qualified Util.Reflex as ReflexUtil
--- TODO: remove
-import Debug.Trace (trace)
-
data TableIn t = TableIn
{ _tableIn_init :: Init
, _tableIn_currentPage :: Dynamic t Int
diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs
index c2fde58..2561156 100644
--- a/common/src/Common/Message/Key.hs
+++ b/common/src/Common/Message/Key.hs
@@ -56,6 +56,7 @@ data Key =
| Income_AddLong
| Income_AddShort
+ | Income_Name
| Income_Amount
| Income_Clone
| Income_CumulativeSince Text
diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs
index 3173561..25e9f4b 100644
--- a/common/src/Common/Message/Translation.hs
+++ b/common/src/Common/Message/Translation.hs
@@ -237,10 +237,15 @@ m l Income_AddShort =
English -> "Add"
French -> "Ajouter"
+m l Income_Name =
+ case l of
+ English -> "Name"
+ French -> "Nom"
+
m l Income_Amount =
case l of
- English -> "Amount"
- French -> "Montant"
+ English -> "Income"
+ French -> "Revenu"
m l Income_Clone =
case l of