From 49426740e8e0c59040f4f3721a658f225572582b Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 28 Nov 2017 09:11:19 +0100 Subject: Add search for payments --- client/src/View/Payment/Header.hs | 25 +++++++++++++++++++------ client/src/View/Payment/Pages.hs | 37 +++++++++++++++++++++---------------- client/src/View/Payment/Table.hs | 9 ++++----- 3 files changed, 44 insertions(+), 27 deletions(-) (limited to 'client/src/View/Payment') diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs index 3f2adc3..f64f11d 100644 --- a/client/src/View/Payment/Header.hs +++ b/client/src/View/Payment/Header.hs @@ -8,10 +8,11 @@ import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) import qualified Data.List as L hiding (groupBy) import Data.Maybe (fromMaybe) +import Data.Text (Text) import qualified Data.Text as T import qualified Data.Time as Time import Prelude hiding (init) -import Reflex.Dom (MonadWidget) +import Reflex.Dom (Dynamic, MonadWidget) import qualified Reflex.Dom as R import Common.Model (Currency, ExceedingPayer (..), @@ -21,7 +22,8 @@ import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Common.View.Format as Format -import Component (ButtonIn (..)) +import Component (ButtonIn (..), InputIn (..), + InputOut (..)) import qualified Component as Component import qualified Util.List as L @@ -29,16 +31,19 @@ data HeaderIn t = HeaderIn { _headerIn_init :: Init } -data HeaderOut = HeaderOut - { +data HeaderOut t = HeaderOut + { _headerOut_search :: Dynamic t Text } -widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut +widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t) widget headerIn = R.divClass "header" $ do payerAndAdd incomes payments users currency + search <- searchLine infos payments users currency - return $ HeaderOut {} + return $ HeaderOut + { _headerOut_search = search + } where init = _headerIn_init headerIn incomes = _init_incomes init payments = filter ((==) Punctual . _payment_frequency) (_init_payments init) @@ -98,3 +103,11 @@ infos payments users currency = . L.groupBy fst . map (\p -> (_payment_user p, _payment_cost p)) $ payments + +searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text) +searchLine = + R.divClass "searchLine" $ + _inputOut_value <$> (Component.input $ InputIn + { _inputIn_reset = R.never + , _inputIn_label = Msg.get Msg.Search_Name + }) diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs index 81555ab..dfd92c0 100644 --- a/client/src/View/Payment/Pages.hs +++ b/client/src/View/Payment/Pages.hs @@ -8,7 +8,7 @@ import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Frequency (..), Payment (..)) +import Common.Model (Payment (..)) import Component (ButtonIn (..), ButtonOut (..)) import qualified Component as Component @@ -16,52 +16,57 @@ import qualified Component as Component import qualified Icon import qualified View.Payment.Constants as Constants -data PagesIn = PagesIn - { _pagesIn_payments :: [Payment] +data PagesIn t = PagesIn + { _pagesIn_payments :: Dynamic t [Payment] } data PagesOut t = PagesOut { _pagesOut_currentPage :: Dynamic t Int } -widget :: forall t m. MonadWidget t m => PagesIn -> m (PagesOut t) +widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t) widget pagesIn = do R.divClass "pages" $ do rec currentPage <- R.holdDyn 1 . R.leftmost $ [ firstPageClic, previousPageClic, pageClic, nextPageClic, lastPageClic ] - firstPageClic <- pageButton (R.constDyn 0) (R.constDyn 1) Icon.doubleLeftBar + firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar - previousPageClic <- pageButton (R.constDyn 0) (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft + previousPageClic <- pageButton noCurrentPage (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft - pageClic <- pageEvent <$> (R.simpleList (fmap (range maxPage) currentPage) $ \p -> - pageButton currentPage p (R.dynText $ fmap (T.pack . show) p)) + pageClic <- pageEvent <$> (R.simpleList (range <$> currentPage <*> maxPage) $ \p -> + pageButton (Just <$> currentPage) p (R.dynText $ fmap (T.pack . show) p)) - nextPageClic <- pageButton (R.constDyn 0) (fmap (\x -> min (x + 1) maxPage) currentPage) Icon.doubleRight + nextPageClic <- pageButton noCurrentPage ((\c m -> min (c + 1) m) <$> currentPage <*> maxPage) Icon.doubleRight - lastPageClic <- pageButton (R.constDyn 0) (R.constDyn maxPage) Icon.doubleRightBar + lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar return $ PagesOut { _pagesOut_currentPage = currentPage } - where paymentCount = length . filter ((==) Punctual . _payment_frequency) . _pagesIn_payments $ pagesIn - maxPage = ceiling $ toRational paymentCount / toRational Constants.paymentsPerPage + where maxPage = + R.ffor (_pagesIn_payments pagesIn) (\payments -> + ceiling $ toRational (length payments) / toRational Constants.paymentsPerPage + ) + pageEvent = R.switchPromptlyDyn . fmap R.leftmost + noCurrentPage = R.constDyn Nothing + range :: Int -> Int -> [Int] -range maxPage currentPage = [start..end] +range currentPage maxPage = [start..end] where sidePages = 2 - start = max 1 (currentPage - sidePages) + start = max 1 (min (currentPage - sidePages) (maxPage - sidePages * 2)) end = min maxPage (start + sidePages * 2) -pageButton :: forall t m. MonadWidget t m => Dynamic t Int -> Dynamic t Int -> m () -> m (Event t Int) +pageButton :: forall t m. MonadWidget t m => Dynamic t (Maybe Int) -> Dynamic t Int -> m () -> m (Event t Int) pageButton currentPage page content = do clic <- _buttonOut_clic <$> (Component.button $ ButtonIn { _buttonIn_class = do cp <- currentPage p <- page - if cp == p then "page current" else "page" + if cp == Just p then "page current" else "page" , _buttonIn_content = content , _buttonIn_waiting = R.never }) diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs index d8093a5..0c3b769 100644 --- a/client/src/View/Payment/Table.hs +++ b/client/src/View/Payment/Table.hs @@ -12,8 +12,7 @@ import Prelude hiding (init) import Reflex.Dom (Dynamic, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Category (..), Frequency (..), - Init (..), Payment (..), +import Common.Model (Category (..), Init (..), Payment (..), PaymentCategory (..), User (..)) import qualified Common.Model as CM import qualified Common.Msg as Msg @@ -26,6 +25,7 @@ import qualified View.Payment.Constants as Constants data TableIn t = TableIn { _tableIn_init :: Init , _tableIn_currentPage :: Dynamic t Int + , _tableIn_payments :: Dynamic t [Payment] } data TableOut = TableOut @@ -47,8 +47,8 @@ widget tableIn = do R.divClass "cell" $ R.blank let init = _tableIn_init tableIn currentPage = _tableIn_currentPage tableIn - payments = _init_payments init - paymentRange = fmap (getPaymentRange payments) currentPage + payments = _tableIn_payments tableIn + paymentRange = getPaymentRange <$> payments <*> currentPage R.simpleList paymentRange (paymentRow init) return $ TableOut {} @@ -58,7 +58,6 @@ getPaymentRange payments currentPage = . 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 () -- cgit v1.2.3