aboutsummaryrefslogtreecommitdiff
path: root/client
diff options
context:
space:
mode:
Diffstat (limited to 'client')
-rw-r--r--client/client.cabal1
-rw-r--r--client/src/Component/Input.hs2
-rw-r--r--client/src/Icon.hs8
-rw-r--r--client/src/Util/Dom.hs19
-rw-r--r--client/src/View/Payment.hs7
-rw-r--r--client/src/View/Payment/Constants.hs6
-rw-r--r--client/src/View/Payment/Pages.hs51
-rw-r--r--client/src/View/Payment/Table.hs59
-rw-r--r--client/src/View/SignIn.hs4
9 files changed, 98 insertions, 59 deletions
diff --git a/client/client.cabal b/client/client.cabal
index fdf764e..02a7549 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -39,7 +39,6 @@ Executable client
View.App
View.Header
View.Payment
- View.Payment.Constants
View.Payment.Header
View.Payment.Pages
View.Payment.Table
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 7eec7d0..24aac22 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -45,7 +45,7 @@ input inputIn =
R.el "label" $ R.text (_inputIn_label inputIn)
reset <- Button.button $ ButtonIn
- { _buttonIn_class = R.constDyn ""
+ { _buttonIn_class = R.constDyn "reset"
, _buttonIn_content = Icon.cross
, _buttonIn_waiting = R.never
}
diff --git a/client/src/Icon.hs b/client/src/Icon.hs
index 555d928..dae5e7f 100644
--- a/client/src/Icon.hs
+++ b/client/src/Icon.hs
@@ -29,8 +29,8 @@ cross =
delete :: forall t m. MonadWidget t m => m ()
delete =
- svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
- svgAttr "path" (M.fromList [("d", "M3 6v18h18v-18h-18zm5 14c0 .552-.448 1-1 1s-1-.448-1-1v-10c0-.552.448-1 1-1s1 .448 1 1v10zm5 0c0 .552-.448 1-1 1s-1-.448-1-1v-10c0-.552.448-1 1-1s1 .448 1 1v10zm5 0c0 .552-.448 1-1 1s-1-.448-1-1v-10c0-.552.448-1 1-1s1 .448 1 1v10zm4-18v2h-20v-2h5.711c.9 0 1.631-1.099 1.631-2h5.315c0 .901.73 2 1.631 2h5.712z")]) $ R.blank
+ svgAttr "svg" (M.fromList [ ("width", "18"), ("height", "18"), ("viewBox", "0 0 1792 1792") ]) $
+ svgAttr "path" (M.fromList [("d", "M704 1376v-704q0-14-9-23t-23-9h-64q-14 0-23 9t-9 23v704q0 14 9 23t23 9h64q14 0 23-9t9-23zm256 0v-704q0-14-9-23t-23-9h-64q-14 0-23 9t-9 23v704q0 14 9 23t23 9h64q14 0 23-9t9-23zm256 0v-704q0-14-9-23t-23-9h-64q-14 0-23 9t-9 23v704q0 14 9 23t23 9h64q14 0 23-9t9-23zm-544-992h448l-48-117q-7-9-17-11h-317q-10 2-17 11zm928 32v64q0 14-9 23t-23 9h-96v948q0 83-47 143.5t-113 60.5h-832q-66 0-113-58.5t-47-141.5v-952h-96q-14 0-23-9t-9-23v-64q0-14 9-23t23-9h309l70-167q15-37 54-63t79-26h320q40 0 79 26t54 63l70 167h309q14 0 23 9t9 23z")]) $ R.blank
doubleLeft :: forall t m. MonadWidget t m => m ()
doubleLeft =
@@ -54,8 +54,8 @@ doubleRightBar =
edit :: forall t m. MonadWidget t m => m ()
edit =
- svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
- svgAttr "path" (M.fromList [("d", "M18.363 8.464l1.433 1.431-12.67 12.669-7.125 1.436 1.439-7.127 12.665-12.668 1.431 1.431-12.255 12.224-.726 3.584 3.584-.723 12.224-12.257zm-.056-8.464l-2.815 2.817 5.691 5.692 2.817-2.821-5.693-5.688zm-12.318 18.718l11.313-11.316-.705-.707-11.313 11.314.705.709z")]) $ R.blank
+ svgAttr "svg" (M.fromList [ ("width", "18"), ("height", "18"), ("viewBox", "0 0 1792 1792") ]) $
+ svgAttr "path" (M.fromList [("d", "M491 1536l91-91-235-235-91 91v107h128v128h107zm523-928q0-22-22-22-10 0-17 7l-542 542q-7 7-7 17 0 22 22 22 10 0 17-7l542-542q7-7 7-17zm-54-192l416 416-832 832h-416v-416zm683 96q0 53-37 90l-166 166-416-416 166-165q36-38 90-38 53 0 91 38l235 234q37 39 37 91z")]) $ R.blank
loading :: forall t m. MonadWidget t m => m ()
loading =
diff --git a/client/src/Util/Dom.hs b/client/src/Util/Dom.hs
new file mode 100644
index 0000000..f3e9c88
--- /dev/null
+++ b/client/src/Util/Dom.hs
@@ -0,0 +1,19 @@
+module Util.Dom
+ ( divVisibleIf
+ , divClassVisibleIf
+ ) where
+
+import qualified Data.Map as M
+import Data.Text (Text)
+import Reflex.Dom (Dynamic, MonadWidget)
+import qualified Reflex.Dom as R
+
+divVisibleIf :: forall t m a. MonadWidget t m => Dynamic t Bool -> m a -> m a
+divVisibleIf cond content = divClassVisibleIf cond "" content
+
+divClassVisibleIf :: forall t m a. MonadWidget t m => Dynamic t Bool -> Text -> m a -> m a
+divClassVisibleIf cond className content =
+ R.elDynAttr
+ "div"
+ (fmap (\c -> (M.singleton "class" className) `M.union` if c then M.empty else M.singleton "style" "display:none") cond)
+ content
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 ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 15:54:39 +0000