diff options
| -rw-r--r-- | ISSUES.md | 4 | ||||
| -rw-r--r-- | client/client.cabal | 4 | ||||
| -rw-r--r-- | client/src/Component.hs | 1 | ||||
| -rw-r--r-- | client/src/Component/Table.hs | 38 | ||||
| -rw-r--r-- | client/src/View/App.hs | 40 | ||||
| -rw-r--r-- | client/src/View/Income/Income.hs | 68 | ||||
| -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.hs | 3 | ||||
| -rw-r--r-- | common/src/Common/Message/Key.hs | 1 | ||||
| -rw-r--r-- | common/src/Common/Message/Translation.hs | 9 |
10 files changed, 147 insertions, 29 deletions
@@ -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 |