aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--README.md5
-rw-r--r--client/client.cabal1
-rw-r--r--client/src/Component.hs1
-rw-r--r--client/src/Component/Button.hs4
-rw-r--r--client/src/Component/Modal.hs38
-rw-r--r--client/src/View/Payment.hs18
-rw-r--r--client/src/View/Payment/Header.hs130
-rw-r--r--common/src/Common/Model/Frequency.hs2
-rw-r--r--public/css/reset.css12
-rw-r--r--server/server.cabal2
-rw-r--r--server/src/Design/Dialog.hs22
-rw-r--r--server/src/Design/Global.hs16
-rw-r--r--server/src/Design/Modal.hs43
13 files changed, 184 insertions, 110 deletions
diff --git a/README.md b/README.md
index 34ae53e..ec8c139 100644
--- a/README.md
+++ b/README.md
@@ -60,8 +60,10 @@ TODO
### Interface
-- Search payments by frequency.
- Add a payment.
+- Edit a payment.
+- Delete a payment.
+- Clone a payment.
#### Bonus
@@ -76,6 +78,7 @@ TODO
- R.def for custom components.
- Move up element ids security (editOwn is actually at db level).
- move persistence methods to a module.
+- try DuplicateRecordFields (https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields)
### Tooling
diff --git a/client/client.cabal b/client/client.cabal
index 02a7549..1064e7d 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -34,6 +34,7 @@ Executable client
other-modules:
Component.Button
Component.Input
+ Component.Modal
Icon
Util.List
View.App
diff --git a/client/src/Component.hs b/client/src/Component.hs
index 4c9541b..dea384e 100644
--- a/client/src/Component.hs
+++ b/client/src/Component.hs
@@ -2,3 +2,4 @@ module Component (module X) where
import Component.Button as X
import Component.Input as X
+import Component.Modal as X
diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index 754b903..3ee9561 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -1,8 +1,8 @@
module Component.Button
( ButtonIn(..)
- , buttonInDefault
, ButtonOut(..)
, button
+ , buttonInDefault
) where
import qualified Data.Map as M
@@ -19,7 +19,7 @@ data ButtonIn t m = ButtonIn
, _buttonIn_waiting :: Event t Bool
}
-buttonInDefault :: forall t m. MonadWidget t m => ButtonIn t m
+buttonInDefault :: forall t m. (MonadWidget t m) => ButtonIn t m
buttonInDefault = ButtonIn
{ _buttonIn_class = R.constDyn ""
, _buttonIn_content = R.blank
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
new file mode 100644
index 0000000..bfb5e02
--- /dev/null
+++ b/client/src/Component/Modal.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Component.Modal
+ ( ModalIn(..)
+ , ModalOut(..)
+ , modal
+ ) where
+
+import qualified Data.Map as M
+import Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+data ModalIn t m = ModalIn
+ { _modalIn_show :: Event t ()
+ , _modalIn_content :: m ()
+ }
+
+data ModalOut = ModalOut {}
+
+modal :: forall t m. MonadWidget t m => ModalIn t m -> m ModalOut
+modal modalIn = do
+ rec
+ showModal <- R.holdDyn False $ R.leftmost
+ [ True <$ _modalIn_show modalIn
+ , False <$ curtainClick
+ ]
+
+ let attr = flip fmap showModal (\s -> M.fromList $
+ [ ("style", if s then "display:block" else "display:none")
+ , ("class", "modal")
+ ])
+
+ curtainClick <- R.elDynAttr "div" attr $ do
+ (curtain, _) <- R.elAttr' "div" (M.singleton "class" "curtain") $ R.blank
+ R.divClass "content" $ _modalIn_content modalIn
+ return $ R.domEvent R.Click curtain
+
+ return $ ModalOut {}
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index f4aaf5c..42da8fb 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -8,8 +8,7 @@ import Prelude hiding (init)
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Frequency (..), Init (..), Payment (..))
-import Common.Util.Text as T
+import Common.Model (Init (..))
import View.Payment.Header (HeaderIn (..), HeaderOut (..))
import qualified View.Payment.Header as Header
@@ -31,13 +30,6 @@ widget paymentIn = do
R.divClass "payment" $ do
rec
let init = _paymentIn_init paymentIn
-
- filterPayment s p = search s (_payment_name p) && (_payment_frequency p == Punctual)
-
- payments = fmap
- (\s -> filter (filterPayment s) (_init_payments init))
- (_headerOut_search header)
-
paymentsPerPage = 7
header <- Header.widget $ HeaderIn
@@ -47,14 +39,14 @@ widget paymentIn = do
_ <- Table.widget $ TableIn
{ _tableIn_init = init
, _tableIn_currentPage = _pagesOut_currentPage pages
- , _tableIn_payments = payments
+ , _tableIn_payments = _headerOut_searchPayments header
, _tableIn_perPage = paymentsPerPage
}
pages <- Pages.widget $ PagesIn
- { _pagesIn_total = length <$> payments
+ { _pagesIn_total = length <$> _headerOut_searchPayments header
, _pagesIn_perPage = paymentsPerPage
- , _pagesIn_reset = (fmap $ const ()) . R.updated $ _headerOut_search header
+ , _pagesIn_reset = (fmap $ const ()) . R.updated $ _headerOut_searchName header
}
- return $ PaymentOut {}
+ pure $ PaymentOut {}
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index f64f11d..a694136 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -7,23 +7,26 @@ module View.Payment.Header
import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
import qualified Data.List as L hiding (groupBy)
+import qualified Data.Map as M
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 (Dynamic, MonadWidget)
+import Reflex.Dom (Dynamic, MonadWidget, Reflex)
import qualified Reflex.Dom as R
import Common.Model (Currency, ExceedingPayer (..),
Frequency (..), Income (..), Init (..),
- Payment (..), User (..), UserId)
+ Payment (..), 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 Component (ButtonIn (..), InputIn (..),
- InputOut (..))
+import Component (ButtonIn (..), ButtonOut (..),
+ InputIn (..), InputOut (..),
+ ModalIn (..))
import qualified Component as Component
import qualified Util.List as L
@@ -32,23 +35,37 @@ data HeaderIn t = HeaderIn
}
data HeaderOut t = HeaderOut
- { _headerOut_search :: Dynamic t Text
+ { _headerOut_searchName :: Dynamic t Text
+ , _headerOut_searchPayments :: Dynamic t [Payment]
}
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
+ payerAndAdd incomes punctualPayments users currency
+ (searchName, searchFrequency) <- searchLine
+ let searchPayments = getSearchPayments searchName searchFrequency payments
+ infos searchPayments users currency
return $ HeaderOut
- { _headerOut_search = search
+ { _headerOut_searchName = searchName
+ , _headerOut_searchPayments = searchPayments
}
- where init = _headerIn_init headerIn
- incomes = _init_incomes init
- payments = filter ((==) Punctual . _payment_frequency) (_init_payments init)
- users = _init_users init
- currency = _init_currency init
+ where
+ init = _headerIn_init headerIn
+ incomes = _init_incomes init
+ payments = _init_payments init
+ punctualPayments = filter ((==) Punctual . _payment_frequency) payments
+ users = _init_users init
+ currency = _init_currency init
+
+getSearchPayments :: forall t. (Reflex t) => Dynamic t Text -> Dynamic t Frequency -> [Payment] -> Dynamic t [Payment]
+getSearchPayments name frequency payments = do
+ n <- name
+ f <- frequency
+ pure $ flip filter payments (\p ->
+ ( T.search n (_payment_name p)
+ && (_payment_frequency p == f)
+ ))
payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> Currency -> m ()
payerAndAdd incomes payments users currency = do
@@ -65,49 +82,62 @@ payerAndAdd incomes payments users currency = do
R.text "+ "
R.text . Format.price currency $ _exceedingPayer_amount p
)
- _ <- Component.button $ ButtonIn
+ addPayment <- _buttonOut_clic <$> (Component.button $ ButtonIn
{ _buttonIn_class = R.constDyn "addPayment"
, _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
, _buttonIn_waiting = R.never
+ })
+ _ <- Component.modal $ ModalIn
+ { _modalIn_show = addPayment
+ , _modalIn_content = R.el "h1" $ R.text "Ajouter un paiement"
}
return ()
-infos :: forall t m. MonadWidget t m => [Payment] -> [User] -> Currency -> m ()
+searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text, Dynamic t Frequency)
+searchLine = do
+ R.divClass "searchLine" $ do
+ searchName <- _inputOut_value <$> (Component.input $ InputIn
+ { _inputIn_reset = R.never
+ , _inputIn_label = Msg.get Msg.Search_Name
+ })
+
+ let frequencies = M.fromList
+ [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+ , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+ ]
+
+ searchFrequency <- R._dropdown_value <$>
+ R.dropdown Punctual (R.constDyn frequencies) R.def
+
+ return (searchName, searchFrequency)
+
+infos :: forall t m. MonadWidget t m => Dynamic t [Payment] -> [User] -> Currency -> m ()
infos payments users currency =
R.divClass "infos" $ do
- R.elClass "span" "total" $ do
- R.text . Msg.get $ Msg.Payment_Worth
- (T.intercalate " "
- [ (Format.number paymentCount)
- , if paymentCount > 1
- then Msg.get Msg.Payment_Many
- else Msg.get Msg.Payment_One
- ])
- (Format.price currency total)
- R.elClass "span" "partition" . R.text $
- T.intercalate ", "
- . map (\(userId, userTotal) ->
- Msg.get $ Msg.Payment_By
- (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
- (Format.price currency userTotal)
- )
- $ totalByUser
- where paymentCount = length payments
- total = sum . map _payment_cost $ payments
-
- totalByUser :: [(UserId, Int)]
- totalByUser =
- L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
- . map (\(u, xs) -> (u, sum . map snd $ xs))
- . L.groupBy fst
- . map (\p -> (_payment_user p, _payment_cost p))
- $ payments
+ R.elClass "span" "total" $ do
+ R.dynText $ do
+ ps <- payments
+ let paymentCount = length ps
+ total = sum . map _payment_cost $ ps
+ pure . Msg.get $ Msg.Payment_Worth
+ (T.intercalate " "
+ [ (Format.number paymentCount)
+ , if paymentCount > 1
+ then Msg.get Msg.Payment_Many
+ else Msg.get Msg.Payment_One
+ ])
+ (Format.price currency total)
-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
- })
+ R.elClass "span" "partition" . R.dynText $ do
+ ps <- payments
+ let totalByUser =
+ L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
+ . map (\(u, xs) -> (u, sum . map snd $ xs))
+ . L.groupBy fst
+ . map (\p -> (_payment_user p, _payment_cost p))
+ $ ps
+ pure . T.intercalate ", " . flip map totalByUser $ \(userId, userTotal) ->
+ Msg.get $ Msg.Payment_By
+ (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
+ (Format.price currency userTotal)
diff --git a/common/src/Common/Model/Frequency.hs b/common/src/Common/Model/Frequency.hs
index ee502e8..48e75ea 100644
--- a/common/src/Common/Model/Frequency.hs
+++ b/common/src/Common/Model/Frequency.hs
@@ -8,7 +8,7 @@ import GHC.Generics (Generic)
data Frequency =
Punctual
| Monthly
- deriving (Eq, Read, Show, Generic)
+ deriving (Eq, Read, Show, Generic, Ord)
instance FromJSON Frequency
instance ToJSON Frequency
diff --git a/public/css/reset.css b/public/css/reset.css
index 42f3b8c..2eecc94 100644
--- a/public/css/reset.css
+++ b/public/css/reset.css
@@ -56,17 +56,5 @@ button:hover { cursor: pointer; }
button::-moz-focus-inner { border: 0; }
:focus { outline: none; }
-select:-moz-focusring {
- color: transparent;
- text-shadow: 0 0 0 #000;
-}
-select {
- -webkit-appearance: none;
- -moz-appearance: none;
- text-indent: 1px;
- text-overflow: '';
- cursor: pointer;
-}
-
html { box-sizing: border-box; }
*, *:before, *:after { box-sizing: inherit; }
diff --git a/server/server.cabal b/server/server.cabal
index d1dbd50..ada7040 100644
--- a/server/server.cabal
+++ b/server/server.cabal
@@ -63,12 +63,12 @@ Executable server
Cookie
Design.Color
Design.Constants
- Design.Dialog
Design.Errors
Design.Form
Design.Global
Design.Helper
Design.Media
+ Design.Modal
Design.Tooltip
Design.View.Header
Design.View.Payment
diff --git a/server/src/Design/Dialog.hs b/server/src/Design/Dialog.hs
deleted file mode 100644
index 034a8b1..0000000
--- a/server/src/Design/Dialog.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module Design.Dialog
- ( design
- ) where
-
-import Data.Monoid ((<>))
-
-import Clay
-
-design :: Css
-design = do
-
- ".content" ? do
- minWidth (px 270)
-
- ".paymentDialog" & do
- ".radioGroup" ? ".title" ? display none
- ".selectInput" ? do
- select ? width (pct 100)
- marginBottom (em 1)
-
- ".deletePaymentDialog" <> ".deleteIncomeDialog" ? do
- h1 ? marginBottom (em 1.5)
diff --git a/server/src/Design/Global.hs b/server/src/Design/Global.hs
index 5e5035c..4da4ffb 100644
--- a/server/src/Design/Global.hs
+++ b/server/src/Design/Global.hs
@@ -3,19 +3,17 @@ module Design.Global
) where
import Clay
-
import Data.Text.Lazy (Text)
-import qualified Design.Dialog as Dialog
-import qualified Design.Errors as Errors
-import qualified Design.Form as Form
-import qualified Design.Tooltip as Tooltip
-import qualified Design.Views as Views
-
import qualified Design.Color as Color
import qualified Design.Constants as Constants
+import qualified Design.Errors as Errors
+import qualified Design.Form as Form
import qualified Design.Helper as Helper
import qualified Design.Media as Media
+import qualified Design.Modal as Modal
+import qualified Design.Tooltip as Tooltip
+import qualified Design.Views as Views
globalDesign :: Text
globalDesign = renderWith compact [] global
@@ -23,7 +21,7 @@ globalDesign = renderWith compact [] global
global :: Css
global = do
".errors" ? Errors.design
- ".dialog" ? Dialog.design
+ ".modal" ? Modal.design
".tooltip" ? Tooltip.design
Views.design
Form.design
@@ -84,6 +82,8 @@ global = do
rotateKeyframes
rotateAnimation
+ select ? cursor pointer
+
rotateAnimation :: Css
rotateAnimation = do
animationName "rotate"
diff --git a/server/src/Design/Modal.hs b/server/src/Design/Modal.hs
new file mode 100644
index 0000000..2612257
--- /dev/null
+++ b/server/src/Design/Modal.hs
@@ -0,0 +1,43 @@
+module Design.Modal
+ ( design
+ ) where
+
+import Data.Monoid ((<>))
+
+import Clay
+
+design :: Css
+design = do
+
+ ".curtain" ? do
+ position fixed
+ cursor pointer
+ top (px 0)
+ left (px 0)
+ width (pct 100)
+ height (pct 100)
+ backgroundColor (rgba 0 0 0 0.5)
+ zIndex 1000
+ opacity 1
+ transition "all" (sec 0.2) ease (sec 0)
+
+ ".content" ? do
+ minWidth (px 270)
+ position fixed
+ top (pct 25)
+ left (pct 50)
+ "transform" -: "translate(-50%, -25%)"
+ zIndex 1000
+ backgroundColor white
+ sym padding (px 20)
+ sym borderRadius (px 5)
+ boxShadow (px 0) (px 0) (px 15) (rgba 0 0 0 0.5)
+
+ ".paymentModal" & do
+ ".radioGroup" ? ".title" ? display none
+ ".selectInput" ? do
+ select ? width (pct 100)
+ marginBottom (em 1)
+
+ ".deletePaymentModal" <> ".deleteIncomeModal" ? do
+ h1 ? marginBottom (em 1.5)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-08 18:37:14 +0000