aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/App.hs24
-rw-r--r--client/src/View/Header.hs26
-rw-r--r--client/src/View/Payment.hs22
-rw-r--r--client/src/View/Payment/Constants.hs2
-rw-r--r--client/src/View/Payment/Header.hs70
-rw-r--r--client/src/View/Payment/Pages.hs8
-rw-r--r--client/src/View/Payment/Table.hs28
-rw-r--r--client/src/View/SignIn.hs32
8 files changed, 134 insertions, 78 deletions
diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index 442fa3e..64ca303 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -1,22 +1,18 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
-
module View.App
( widget
) where
-import Prelude hiding (error, init)
-import qualified Reflex.Dom as R
+import Prelude hiding (error, init)
+import qualified Reflex.Dom as R
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import Common.Model (InitResult (..))
+import Common.Model (InitResult (..))
+import qualified Common.Msg as Msg
-import View.Header (HeaderIn (..))
-import qualified View.Header as Header
-import View.Payment (PaymentIn (..))
-import qualified View.Payment as Payment
-import qualified View.SignIn as SignIn
+import View.Header (HeaderIn (..))
+import qualified View.Header as Header
+import View.Payment (PaymentIn (..))
+import qualified View.Payment as Payment
+import qualified View.SignIn as SignIn
widget :: InitResult -> IO ()
widget initResult =
@@ -36,7 +32,7 @@ widget initResult =
InitEmpty result ->
SignIn.view result
- signOutContent = SignIn.view (Right . Just $ Message.get Key.SignIn_DisconnectSuccess)
+ signOutContent = SignIn.view (Right . Just $ Msg.get Msg.SignIn_DisconnectSuccess)
_ <- R.widgetHold initialContent (fmap (const signOutContent) signOut)
diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs
index 7afd9bd..4c74383 100644
--- a/client/src/View/Header.hs
+++ b/client/src/View/Header.hs
@@ -1,25 +1,21 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
-
module View.Header
( view
, HeaderIn(..)
, HeaderOut(..)
) where
-import qualified Data.Map as M
-import Data.Time (NominalDiffTime)
-import Prelude hiding (error, init)
-import Reflex.Dom (Event, MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.Map as M
+import Data.Time (NominalDiffTime)
+import Prelude hiding (error, init)
+import Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import Common.Model (Init (..), InitResult (..), User (..))
-import qualified Common.Model as CM
+import Common.Model (Init (..), InitResult (..), User (..))
+import qualified Common.Model as CM
+import qualified Common.Msg as Msg
-import Component.Button (ButtonIn (..))
-import qualified Component.Button as Component
+import Component.Button (ButtonIn (..))
+import qualified Component.Button as Component
import qualified Icon
data HeaderIn = HeaderIn
@@ -35,7 +31,7 @@ view headerIn =
R.el "header" $ do
R.divClass "title" $
- R.text $ Message.get Key.App_Title
+ R.text $ Msg.get Msg.App_Title
signOut <- nameSignOut $ _headerIn_initResult headerIn
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index f70c8cd..934f720 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -1,21 +1,20 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
-
module View.Payment
( widget
, PaymentIn(..)
, PaymentOut(..)
) where
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
+import Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
-import Common.Model (Init (..))
+import Common.Model (Init (..))
-import View.Payment.Pages (PagesIn (..), PagesOut (..))
-import qualified View.Payment.Pages as Pages
-import View.Payment.Table (TableIn (..))
-import qualified View.Payment.Table as Table
+import View.Payment.Header (HeaderIn (..))
+import qualified View.Payment.Header as Header
+import View.Payment.Pages (PagesIn (..), PagesOut (..))
+import qualified View.Payment.Pages as Pages
+import View.Payment.Table (TableIn (..))
+import qualified View.Payment.Table as Table
data PaymentIn = PaymentIn
{ _paymentIn_init :: Init
@@ -29,6 +28,9 @@ widget :: forall t m. MonadWidget t m => PaymentIn -> m PaymentOut
widget paymentIn = do
R.divClass "payment" $ do
rec
+ _ <- Header.widget $ HeaderIn
+ { _headerIn_init = _paymentIn_init $ paymentIn
+ }
_ <- Table.widget $ TableIn
{ _tableIn_init = _paymentIn_init paymentIn
, _tableIn_currentPage = _pagesOut_currentPage pagesOut
diff --git a/client/src/View/Payment/Constants.hs b/client/src/View/Payment/Constants.hs
index ac2320a..028e328 100644
--- a/client/src/View/Payment/Constants.hs
+++ b/client/src/View/Payment/Constants.hs
@@ -3,4 +3,4 @@ module View.Payment.Constants
) where
paymentsPerPage :: Int
-paymentsPerPage = 8
+paymentsPerPage = 7
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
new file mode 100644
index 0000000..67b4eb4
--- /dev/null
+++ b/client/src/View/Payment/Header.hs
@@ -0,0 +1,70 @@
+module View.Payment.Header
+ ( widget
+ , HeaderIn(..)
+ , HeaderOut(..)
+ ) where
+
+import qualified Data.List as L hiding (groupBy)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import Prelude hiding (init)
+import Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Currency, Frequency (..), Init (..),
+ Payment (..), User (..), UserId)
+import qualified Common.Msg as Msg
+import qualified Common.View.Format as Format
+
+import qualified Util.List as L
+
+data HeaderIn t = HeaderIn
+ { _headerIn_init :: Init
+ }
+
+data HeaderOut = HeaderOut
+ {
+ }
+
+widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut
+widget headerIn =
+ R.divClass "header" $ do
+ infos payments users currency
+ return $ HeaderOut {}
+ where init = _headerIn_init headerIn
+ payments = _init_payments init
+ users = _init_users init
+ currency = _init_currency init
+
+infos :: forall t m. MonadWidget t m => [Payment] -> [User] -> Currency -> m ()
+infos payments users currency =
+ R.divClass "infos" $ do
+ R.elClass "span" "total" $ do
+ R.text . Msg.get $ Msg.Payment_Worth
+ (T.intercalate " "
+ [ (Format.number paymentCount)
+ , if paymentCount > 1
+ then Msg.get Msg.Payment_Many
+ else Msg.get Msg.Payment_One
+ ])
+ (Format.price currency total)
+ R.elClass "span" "partition" . R.text $
+ T.intercalate ", "
+ . map (\(userId, userTotal) ->
+ Msg.get $ Msg.Payment_By
+ (fromMaybe "" . fmap _user_name . L.find ((==) userId . _user_id) $ users)
+ (Format.price currency userTotal)
+ )
+ $ totalByUser
+
+ where punctualPayments = filter ((==) Punctual . _payment_frequency) payments
+ paymentCount = length punctualPayments
+ total = sum . map _payment_cost $ punctualPayments
+
+ totalByUser :: [(UserId, Int)]
+ totalByUser =
+ L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
+ . map (\(u, xs) -> (u, sum . map snd $ xs))
+ . L.groupBy fst
+ . map (\p -> (_payment_user p, _payment_cost p))
+ $ punctualPayments
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index f96cb8e..81555ab 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
-
module View.Payment.Pages
( widget
, PagesIn(..)
@@ -11,7 +8,7 @@ import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Payment (..))
+import Common.Model (Frequency (..), Payment (..))
import Component (ButtonIn (..), ButtonOut (..))
import qualified Component as Component
@@ -48,7 +45,8 @@ widget pagesIn = do
{ _pagesOut_currentPage = currentPage
}
- where maxPage = ceiling $ (toRational . length . _pagesIn_payments $ pagesIn) / toRational Constants.paymentsPerPage
+ where paymentCount = length . filter ((==) Punctual . _payment_frequency) . _pagesIn_payments $ pagesIn
+ maxPage = ceiling $ toRational paymentCount / toRational Constants.paymentsPerPage
pageEvent = R.switchPromptlyDyn . fmap R.leftmost
range :: Int -> Int -> [Int]
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 5c0b709..d8093a5 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
-
module View.Payment.Table
( widget
, TableIn(..)
@@ -15,11 +12,11 @@ import Prelude hiding (init)
import Reflex.Dom (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import Common.Model (Category (..), Init (..), Payment (..),
+import Common.Model (Category (..), Frequency (..),
+ Init (..), Payment (..),
PaymentCategory (..), User (..))
import qualified Common.Model as CM
+import qualified Common.Msg as Msg
import qualified Common.Util.Text as T
import qualified Common.View.Format as Format
@@ -40,11 +37,11 @@ widget tableIn = do
_ <- R.divClass "table" $
R.divClass "lines" $ do
R.divClass "header" $ do
- R.divClass "cell name" $ R.text $ Message.get Key.Payment_Name
- R.divClass "cell cost" $ R.text $ Message.get Key.Payment_Cost
- R.divClass "cell user" $ R.text $ Message.get Key.Payment_User
- R.divClass "cell category" $ R.text $ Message.get Key.Payment_Category
- R.divClass "cell date" $ R.text $ Message.get Key.Payment_Date
+ R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
+ R.divClass "cell cost" $ R.text $ Msg.get Msg.Payment_Cost
+ R.divClass "cell user" $ R.text $ Msg.get Msg.Payment_User
+ R.divClass "cell category" $ R.text $ Msg.get Msg.Payment_Category
+ R.divClass "cell date" $ R.text $ Msg.get Msg.Payment_Date
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
@@ -58,10 +55,11 @@ widget tableIn = do
getPaymentRange :: [Payment] -> Int -> [Payment]
getPaymentRange payments currentPage =
take Constants.paymentsPerPage
- . drop ((currentPage - 1) * Constants.paymentsPerPage)
- . reverse
- . L.sortOn _payment_date
- $ payments
+ . drop ((currentPage - 1) * Constants.paymentsPerPage)
+ . reverse
+ . L.sortOn _payment_date
+ . filter ((==) Punctual . _payment_frequency)
+ $ payments
paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
paymentRow init payment =
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index 1f5b900..69596d8 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -1,25 +1,21 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
-
module View.SignIn
( view
) where
-import qualified Data.Either as Either
-import Data.Monoid ((<>))
-import Data.Text (Text)
-import Data.Time (NominalDiffTime)
-import Prelude hiding (error)
-import Reflex.Dom (Event, MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.Either as Either
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Data.Time (NominalDiffTime)
+import Prelude hiding (error)
+import Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import Common.Model (SignIn (SignIn))
+import Common.Model (SignIn (SignIn))
+import qualified Common.Msg as Msg
-import Component (ButtonIn (..), ButtonOut (..),
- InputIn (..), InputOut (..))
-import qualified Component as Component
+import Component (ButtonIn (..), ButtonOut (..), InputIn (..),
+ InputOut (..))
+import qualified Component as Component
view :: forall t m. MonadWidget t m => Either Text (Maybe Text) -> m ()
view result =
@@ -27,7 +23,7 @@ view result =
rec
input <- Component.input $ InputIn
{ _inputIn_reset = R.ffilter Either.isRight signInResult
- , _inputIn_placeHolder = Message.get Key.SignIn_EmailPlaceholder
+ , _inputIn_placeHolder = Msg.get Msg.SignIn_EmailPlaceholder
}
let userWantsEmailValidation = _inputOut_enter input <> _buttonOut_clic button
@@ -50,7 +46,7 @@ view result =
button <- Component.button $ ButtonIn
{ _buttonIn_class = R.constDyn ""
- , _buttonIn_content = R.text (Message.get Key.SignIn_Button)
+ , _buttonIn_content = R.text (Msg.get Msg.SignIn_Button)
, _buttonIn_waiting = waiting
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 02:39:30 +0000