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/Pages.hs57
-rw-r--r--client/src/View/Payment/Table.hs102
2 files changed, 92 insertions, 67 deletions
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index f9a2b4e..cf3e115 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -1,6 +1,5 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecursiveDo #-}
module View.Payment.Pages
( widget
@@ -8,35 +7,45 @@ module View.Payment.Pages
, PagesOut(..)
) where
-import qualified Data.Text as T
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.Text as T
+import Reflex.Dom (Event, Dynamic, MonadWidget)
+import qualified Reflex.Dom as R
-import Common.Model (Payment(..))
+import Common.Model (Payment (..))
+import Component (ButtonIn (..), ButtonOut (..))
+import qualified Component as Component
import qualified Icon
data PagesIn = PagesIn
{ _pagesIn_payments :: [Payment]
}
-data PagesOut = PagesOut
- {
+data PagesOut t = PagesOut
+ { _pagesOut_currentPage :: Dynamic t Int
}
-widget :: forall t m. MonadWidget t m => PagesIn -> m PagesOut
+widget :: forall t m. MonadWidget t m => PagesIn -> m (PagesOut t)
widget _ = do
- R.divClass "pages" $ do
- page Icon.doubleLeftBar
- page Icon.doubleLeft
- page (R.text . T.pack . show $ (1 :: Integer))
- page (R.text . T.pack . show $ (2 :: Integer))
- page (R.text . T.pack . show $ (3 :: Integer))
- page (R.text . T.pack . show $ (4 :: Integer))
- page (R.text . T.pack . show $ (5 :: Integer))
- page Icon.doubleRight
- page Icon.doubleRightBar
- return $ PagesOut {}
-
-page :: forall t m. MonadWidget t m => m () -> m ()
-page content = R.elClass "button" "page" $ content
+ currentPage <- R.divClass "pages" $ do
+ a <- page 1 Icon.doubleLeftBar
+ b <- page 1 Icon.doubleLeft
+ c <- page 1 (R.text . T.pack . show $ (1 :: Integer))
+ d <- page 2 (R.text . T.pack . show $ (2 :: Integer))
+ e <- page 3 (R.text . T.pack . show $ (3 :: Integer))
+ f <- page 4 (R.text . T.pack . show $ (4 :: Integer))
+ g <- page 5 (R.text . T.pack . show $ (5 :: Integer))
+ h <- page 5 Icon.doubleRight
+ i <- page 5 Icon.doubleRightBar
+ R.holdDyn 1 $ R.leftmost [ a, b, c, d, e, f, g, h, i ]
+ return $ PagesOut
+ { _pagesOut_currentPage = currentPage
+ }
+
+page :: forall t m. MonadWidget t m => Int -> m () -> m (Event t Int)
+page n content =
+ ((fmap (const n)) . _buttonOut_clic) <$> (Component.button $ ButtonIn
+ { _buttonIn_class = "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 f3eb9a7..734511d 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -1,6 +1,5 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecursiveDo #-}
module View.Payment.Table
( widget
@@ -8,34 +7,40 @@ module View.Payment.Table
, TableOut(..)
) where
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.List as L
-import qualified Data.Map as M
-import Prelude hiding (init)
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
+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 (MonadWidget, Dynamic)
+import qualified Reflex.Dom as R
-import qualified Common.Message as Message
+import qualified Common.Message as Message
import qualified Common.Message.Key as Key
-import Common.Model (Payment(..), PaymentCategory(..), Category(..), User(..), Init(..))
-import qualified Common.Model as CM
-import qualified Common.Util.Text as T
+import Common.Model (Category (..), Init (..), Payment (..),
+ PaymentCategory (..), User (..))
+import qualified Common.Model as CM
+import qualified Common.Util.Text as T
import qualified Common.View.Format as Format
import qualified Icon
-data TableIn = TableIn
+data TableIn t = TableIn
{ _tableIn_init :: Init
+ , _tableIn_currentPage :: Dynamic t Int
}
data TableOut = TableOut
{
}
-widget :: forall t m. MonadWidget t m => TableIn -> m TableOut
+visiblePayments :: Int
+visiblePayments = 8
+
+widget :: forall t m. MonadWidget t m => TableIn t -> m TableOut
widget tableIn = do
- R.divClass "table" $
+ R.dynText (fmap (T.pack . show) . _tableIn_currentPage $ tableIn)
+ _ <- R.divClass "table" $
R.divClass "lines" $ do
R.divClass "header" $ do
R.divClass "cell name" $ R.text $ Message.get Key.Payment_Name
@@ -48,39 +53,50 @@ widget tableIn = do
R.divClass "cell" $ R.blank
let init = _tableIn_init tableIn
payments = _init_payments init
- mapM_
- (paymentRow init)
- (take 8 . reverse . L.sortOn _payment_date $ payments)
+ paymentRange = fmap
+ (\p -> take visiblePayments . drop ((p - 1) * visiblePayments) . reverse . L.sortOn _payment_date $ payments)
+ (_tableIn_currentPage tableIn)
+ R.simpleList paymentRange (paymentRow init)
return $ TableOut {}
-paymentRow :: forall t m. MonadWidget t m => Init -> Payment -> m ()
+paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
paymentRow init payment =
R.divClass "row" $ do
- R.divClass "cell name" . R.text $ _payment_name payment
- R.divClass "cell cost" . R.text . Format.price (_init_currency init) $ _payment_cost payment
+ R.divClass "cell name" . R.dynText . fmap _payment_name $ payment
+ R.divClass "cell cost" . R.dynText . fmap (Format.price (_init_currency init) . _payment_cost) $ payment
+
+ let user = flip fmap payment $ \p -> CM.findUser (_payment_user p) (_init_users init)
R.divClass "cell user" $
- case CM.findUser (_payment_user payment) (_init_users init) of
- Just user -> R.text (_user_name user)
- _ -> R.blank
- R.divClass "cell category" $
- case findCategory (_init_categories init) (_init_paymentCategories init) (_payment_name payment) of
- Just category ->
- R.elAttr "span" (M.fromList [("class", "tag"), ("style", T.concat [ "background-color: ", _category_color category ])]) $
- R.text $ _category_name category
- _ ->
- R.blank
+ R.dynText $ flip fmap user $ \mbUser -> case mbUser of
+ Just u -> _user_name u
+ _ -> ""
+
+ let category = flip fmap payment $ \p -> findCategory
+ (_init_categories init)
+ (_init_paymentCategories init)
+ (_payment_name p)
+ R.divClass "cell category" $ do
+ let attrs = flip fmap category $ \maybeCategory -> case maybeCategory of
+ Just c -> M.fromList
+ [ ("class", "tag")
+ , ("style", T.concat [ "background-color: ", _category_color c ])
+ ]
+ Nothing -> M.singleton "display" "none"
+ R.elDynAttr "span" attrs $
+ R.dynText $ flip fmap category $ \mbCategory -> case mbCategory of
+ Just c -> _category_name c
+ _ -> ""
+
R.divClass "cell date" $ do
- R.elClass "span" "shortDate" . R.text $ Format.shortDay (_payment_date payment)
- R.elClass "span" "longDate" . R.text $ Format.longDay (_payment_date payment)
+ R.elClass "span" "shortDate" . R.dynText . fmap (Format.shortDay . _payment_date) $ payment
+ R.elClass "span" "longDate" . R.dynText . fmap (Format.longDay . _payment_date) $ payment
R.divClass "cell button" . R.el "button" $ Icon.clone
- R.divClass "cell button" $
- if _payment_user payment == (_init_currentUser init)
- then R.el "button" $ Icon.edit
- else R.blank
- R.divClass "cell button" $
- if _payment_user payment == (_init_currentUser init)
- then R.el "button" $ Icon.delete
- else R.blank
+ let modifyAttrs = flip fmap payment $ \p ->
+ M.fromList [("class", "cell button"), ("display", if _payment_user p == _init_currentUser init then "block" else "none")]
+ R.elDynAttr "div" modifyAttrs $
+ R.el "button" $ Icon.edit
+ R.elDynAttr "div" modifyAttrs $
+ R.el "button" $ Icon.delete
findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
findCategory categories paymentCategories paymentName = do