diff options
Diffstat (limited to 'client/src/View/Payment')
| -rw-r--r-- | client/src/View/Payment/Constants.hs | 6 | ||||
| -rw-r--r-- | client/src/View/Payment/Pages.hs | 51 | ||||
| -rw-r--r-- | client/src/View/Payment/Table.hs | 59 |
3 files changed, 66 insertions, 50 deletions
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 |