aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/Payment.hs7
-rw-r--r--client/src/View/Payment/Constants.hs6
-rw-r--r--client/src/View/Payment/Pages.hs51
-rw-r--r--client/src/View/Payment/Table.hs59
-rw-r--r--client/src/View/SignIn.hs4
5 files changed, 74 insertions, 53 deletions
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 8aa4d38..f4aaf5c 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -38,6 +38,8 @@ widget paymentIn = do
(\s -> filter (filterPayment s) (_init_payments init))
(_headerOut_search header)
+ paymentsPerPage = 7
+
header <- Header.widget $ HeaderIn
{ _headerIn_init = init
}
@@ -46,10 +48,13 @@ widget paymentIn = do
{ _tableIn_init = init
, _tableIn_currentPage = _pagesOut_currentPage pages
, _tableIn_payments = payments
+ , _tableIn_perPage = paymentsPerPage
}
pages <- Pages.widget $ PagesIn
- { _pagesIn_payments = payments
+ { _pagesIn_total = length <$> payments
+ , _pagesIn_perPage = paymentsPerPage
+ , _pagesIn_reset = (fmap $ const ()) . R.updated $ _headerOut_search header
}
return $ PaymentOut {}
diff --git a/client/src/View/Payment/Constants.hs b/client/src/View/Payment/Constants.hs
deleted file mode 100644
index 028e328..0000000
--- a/client/src/View/Payment/Constants.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module View.Payment.Constants
- ( paymentsPerPage
- ) where
-
-paymentsPerPage :: Int
-paymentsPerPage = 7
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index dfd92c0..55ceb9f 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -4,20 +4,20 @@ module View.Payment.Pages
, PagesOut(..)
) where
-import qualified Data.Text as T
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.Text as T
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
-import Common.Model (Payment (..))
-
-import Component (ButtonIn (..), ButtonOut (..))
-import qualified Component as Component
+import Component (ButtonIn (..), ButtonOut (..))
+import qualified Component as Component
import qualified Icon
-import qualified View.Payment.Constants as Constants
+import qualified Util.Dom as Dom
data PagesIn t = PagesIn
- { _pagesIn_payments :: Dynamic t [Payment]
+ { _pagesIn_total :: Dynamic t Int
+ , _pagesIn_perPage :: Int
+ , _pagesIn_reset :: Event t ()
}
data PagesOut t = PagesOut
@@ -26,9 +26,29 @@ data PagesOut t = PagesOut
widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
widget pagesIn = do
+ currentPage <- Dom.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
+
+ return $ PagesOut
+ { _pagesOut_currentPage = currentPage
+ }
+
+ where
+ total = _pagesIn_total pagesIn
+ perPage = _pagesIn_perPage pagesIn
+ reset = _pagesIn_reset pagesIn
+
+pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
+pageButtons total perPage reset = do
R.divClass "pages" $ do
rec
- currentPage <- R.holdDyn 1 . R.leftmost $ [ firstPageClic, previousPageClic, pageClic, nextPageClic, lastPageClic ]
+ currentPage <- R.holdDyn 1 . R.leftmost $
+ [ firstPageClic
+ , previousPageClic
+ , pageClic
+ , nextPageClic
+ , lastPageClic
+ , (const 1) <$> reset
+ ]
firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
@@ -41,17 +61,10 @@ widget pagesIn = do
lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
- return $ PagesOut
- { _pagesOut_currentPage = currentPage
- }
-
- where maxPage =
- R.ffor (_pagesIn_payments pagesIn) (\payments ->
- ceiling $ toRational (length payments) / toRational Constants.paymentsPerPage
- )
+ return currentPage
+ where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
pageEvent = R.switchPromptlyDyn . fmap R.leftmost
-
noCurrentPage = R.constDyn Nothing
range :: Int -> Int -> [Int]
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 0c3b769..a49be5c 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -4,28 +4,29 @@ module View.Payment.Table
, TableOut(..)
) where
-import qualified Data.List as L
-import qualified Data.Map as M
-import Data.Text (Text)
-import qualified Data.Text as T
-import Prelude hiding (init)
-import Reflex.Dom (Dynamic, MonadWidget)
-import qualified Reflex.Dom as R
-
-import Common.Model (Category (..), 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
+import qualified Data.List as L
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Data.Text as T
+import Prelude hiding (init)
+import Reflex.Dom (Dynamic, MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Category (..), 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
import qualified Icon
-import qualified View.Payment.Constants as Constants
+import qualified Util.Dom as Dom
data TableIn t = TableIn
{ _tableIn_init :: Init
, _tableIn_currentPage :: Dynamic t Int
, _tableIn_payments :: Dynamic t [Payment]
+ , _tableIn_perPage :: Int
}
data TableOut = TableOut
@@ -34,7 +35,8 @@ data TableOut = TableOut
widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut
widget tableIn = do
- _ <- R.divClass "table" $
+ R.divClass "table" $ do
+
R.divClass "lines" $ do
R.divClass "header" $ do
R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name
@@ -45,17 +47,24 @@ widget tableIn = do
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
- let init = _tableIn_init tableIn
- currentPage = _tableIn_currentPage tableIn
- payments = _tableIn_payments tableIn
- paymentRange = getPaymentRange <$> payments <*> currentPage
- R.simpleList paymentRange (paymentRow init)
+ _ <- R.simpleList paymentRange (paymentRow init)
+ return ()
+
+ Dom.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
+ R.text $ Msg.get Msg.Payment_Empty
+
return $ TableOut {}
-getPaymentRange :: [Payment] -> Int -> [Payment]
-getPaymentRange payments currentPage =
- take Constants.paymentsPerPage
- . drop ((currentPage - 1) * Constants.paymentsPerPage)
+ where
+ init = _tableIn_init tableIn
+ currentPage = _tableIn_currentPage tableIn
+ payments = _tableIn_payments tableIn
+ paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage
+
+getPaymentRange :: Int -> [Payment] -> Int -> [Payment]
+getPaymentRange perPage payments currentPage =
+ take perPage
+ . drop ((currentPage - 1) * perPage)
. reverse
. L.sortOn _payment_date
$ payments
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index be6b152..89be737 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -45,7 +45,7 @@ view result =
]
button <- Component.button $ ButtonIn
- { _buttonIn_class = R.constDyn ""
+ { _buttonIn_class = R.constDyn "validate"
, _buttonIn_content = R.text (Msg.get Msg.SignIn_Button)
, _buttonIn_waiting = waiting
}
@@ -57,7 +57,7 @@ view result =
askSignIn :: forall t m. MonadWidget t m => Event t Text -> m (Event t (Either Text Text))
askSignIn email =
fmap getResult <$> R.performRequestAsync xhrRequest
- where xhrRequest = fmap (R.postJson "/signIn" . SignIn) email
+ where xhrRequest = fmap (R.postJson "/askSignIn" . SignIn) email
getResult response =
case R._xhrResponse_responseText response of
Just key ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 03:57:05 +0000