aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View/Payment')
-rw-r--r--client/src/View/Payment/Header.hs25
-rw-r--r--client/src/View/Payment/Pages.hs37
-rw-r--r--client/src/View/Payment/Table.hs9
3 files changed, 44 insertions, 27 deletions
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 ()