From a4acc2e84158fa822f88a1d0bdddb470708b5809 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 3 Jan 2018 17:31:20 +0100 Subject: Modify weelky report and payment search interface - Add payment balance in weekly report - Show a message and hide pages when the search results in no results - Go to page 1 when the search is updated / erased --- client/src/View/Payment.hs | 7 ++++- client/src/View/Payment/Constants.hs | 6 ---- client/src/View/Payment/Pages.hs | 51 +++++++++++++++++++------------ client/src/View/Payment/Table.hs | 59 +++++++++++++++++++++--------------- client/src/View/SignIn.hs | 4 +-- 5 files changed, 74 insertions(+), 53 deletions(-) delete mode 100644 client/src/View/Payment/Constants.hs (limited to 'client/src/View') 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 -> -- cgit v1.2.3