Commit f4f24158 authored by Joris's avatar Joris

Show the payment table with server side paging

parent 58f6c4e2
......@@ -75,14 +75,10 @@ Executable client
View.Income.Reducer
View.Income.Table
View.NotFound
View.Payment.Add
View.Payment.Clone
View.Payment.Delete
View.Payment.Edit
View.Payment.Form
View.Payment.Header
View.Payment.Init
View.Payment.Pages
View.Payment.Payment
View.Payment.Reducer
View.Payment.Table
View.SignIn
......@@ -72,7 +72,7 @@ view input = do
let content = R.switchDyn $ (\(_, _, c) -> c) <$> dyn
-- Delay the event in order to let time for the modal to disappear
R.delay (0.3 :: NominalDiffTime) content
R.delay (0.5 :: NominalDiffTime) content
getAttributes :: Text -> LM.Map Text Text
getAttributes modalClass =
......
......@@ -4,7 +4,7 @@ module Component.Table
, Out(..)
) where
import qualified Data.Map as M
import qualified Data.Map as M
import Data.Text (Text)
import Reflex.Dom (Event, MonadWidget)
import qualified Reflex.Dom as R
......@@ -14,23 +14,23 @@ import qualified Component.Modal as Modal
import qualified Util.Reflex as ReflexUtil
import qualified View.Icon as Icon
data In m t h r a = In
data In m t h r a b c = In
{ _in_headerLabel :: h -> Text
, _in_rows :: [r]
, _in_cell :: h -> r -> Text
, _in_cell :: h -> r -> m ()
, _in_cloneModal :: r -> Modal.Content t m a
, _in_editModal :: r -> Modal.Content t m a
, _in_deleteModal :: r -> Modal.Content t m a
, _in_editModal :: r -> Modal.Content t m b
, _in_deleteModal :: r -> Modal.Content t m c
, _in_isOwner :: r -> Bool
}
data Out t a = Out
data Out t a b c = Out
{ _out_add :: Event t a
, _out_edit :: Event t a
, _out_delete :: Event t a
, _out_edit :: Event t b
, _out_delete :: Event t c
}
view :: forall t m h r a. (MonadWidget t m, Bounded h, Enum h) => In m t h r a -> m (Out t a)
view :: forall t m h r a b c. (MonadWidget t m, Bounded h, Enum h) => In m t h r a b c-> m (Out t a b c)
view input =
R.divClass "table" $ do
rec
......@@ -49,8 +49,7 @@ view input =
R.divClass "row" $ do
flip mapM_ [minBound..] $ \header ->
R.divClass "cell" $
R.text $
_in_cell input header row
_in_cell input header row
cloneButton <-
R.divClass "cell button" $
......
......@@ -58,15 +58,14 @@ widget initResult =
signedWidget :: MonadWidget t m => Init -> Dynamic t Route -> m ()
signedWidget init route = do
R.dyn . R.ffor route $ \case
RootRoute -> do
paymentInit <- Payment.init
RootRoute ->
Payment.view $ Payment.In
{ Payment._in_currentUser = _init_currentUser init
, Payment._in_currency = _init_currency init
, Payment._in_init = paymentInit
, Payment._in_users = _init_users init
}
IncomeRoute -> do
IncomeRoute ->
Income.view $ Income.In
{ Income._in_currentUser = _init_currentUser init
, Income._in_currency = _init_currency init
......
......@@ -27,7 +27,7 @@ import qualified Component.Modal as Modal
import qualified Component.ModalForm as ModalForm
import qualified Util.Ajax as Ajax
data In t = In
data In = In
{ _in_operation :: Operation
}
......@@ -36,7 +36,7 @@ data Operation
| Clone Income
| Edit Income
view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m Income
view :: forall t m a. MonadWidget t m => In -> Modal.Content t m Income
view input cancel = do
rec
......@@ -94,14 +94,14 @@ view input cancel = do
amount =
case op of
New -> ""
Clone income -> T.pack . show . _income_amount $ income
Edit income -> T.pack . show . _income_amount $ income
New -> ""
Clone i -> T.pack . show . _income_amount $ i
Edit i -> T.pack . show . _income_amount $ i
date currentDay =
case op of
Edit income -> _income_date income
_ -> currentDay
Edit i -> _income_date i
_ -> currentDay
ajax =
case op of
......@@ -115,5 +115,5 @@ view input cancel = do
mkPayload =
case op of
Edit income -> \a b -> Aeson.toJSON $ EditIncomeForm (_income_id income) a b
_ -> \a b -> Aeson.toJSON $ CreateIncomeForm a b
Edit i -> \a b -> Aeson.toJSON $ EditIncomeForm (_income_id i) a b
_ -> \a b -> Aeson.toJSON $ CreateIncomeForm a b
......@@ -80,14 +80,14 @@ headerLabel UserHeader = Msg.get Msg.Income_Name
headerLabel DateHeader = Msg.get Msg.Income_Date
headerLabel AmountHeader = Msg.get Msg.Income_Amount
cell :: [User] -> Currency -> Header -> Income -> Text
cell :: forall t m. MonadWidget t m => [User] -> Currency -> Header -> Income -> m ()
cell users currency header income =
case header of
UserHeader ->
Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users
R.text . Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users
DateHeader ->
Format.longDay . _income_date $ income
R.text . Format.longDay . _income_date $ income
AmountHeader ->
Format.price currency . _income_amount $ income
R.text . Format.price currency . _income_amount $ income
module View.Payment.Add
( view
, In(..)
) where
import Control.Monad (join)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import qualified Data.Time.Clock as Time
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Category (..), CreatePaymentForm (..),
Frequency (..), Payment (..),
PaymentCategory (..),
SavedPayment (..))
import qualified Common.Msg as Msg
import qualified Common.Util.Time as TimeUtil
import qualified Component.Modal as Modal
import qualified Util.Ajax as Ajax
import qualified Util.Reflex as ReflexUtil
import qualified View.Payment.Form as Form
data In t = In
{ _in_categories :: [Category]
, _in_paymentCategories :: Dynamic t [PaymentCategory]
, _in_frequency :: Dynamic t Frequency
}
view :: forall t m. MonadWidget t m => In t -> Modal.Content t m SavedPayment
view input cancel = do
currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
formOutput <- R.dyn $ do
paymentCategories <- _in_paymentCategories input
frequency <- _in_frequency input
return $ Form.view $ Form.In
{ Form._in_cancel = cancel
, Form._in_headerLabel = Msg.get Msg.Payment_Add
, Form._in_categories = _in_categories input
, Form._in_paymentCategories = paymentCategories
, Form._in_name = ""
, Form._in_cost = ""
, Form._in_date = currentDay
, Form._in_category = -1
, Form._in_frequency = frequency
, Form._in_mkPayload = CreatePaymentForm
, Form._in_ajax = Ajax.post
}
hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
addPayment <- ReflexUtil.flatten (Form._output_addPayment <$> formOutput)
return (hide, addPayment)
module View.Payment.Clone
( In(..)
, view
) where
import qualified Control.Monad as Monad
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import qualified Data.Time.Clock as Time
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Category (..), CategoryId,
CreatePaymentForm (..), Frequency (..),
Payment (..), PaymentCategory (..),
SavedPayment (..))
import qualified Common.Msg as Msg
import qualified Common.Util.Time as TimeUtil
import qualified Component.Modal as Modal
import qualified Util.Ajax as Ajax
import qualified Util.Reflex as ReflexUtil
import qualified View.Payment.Form as Form
data In t = In
{ _in_show :: Event t ()
, _in_categories :: [Category]
, _in_paymentCategories :: Dynamic t [PaymentCategory]
, _in_payment :: Dynamic t Payment
, _in_category :: Dynamic t CategoryId
}
view :: forall t m. MonadWidget t m => In t -> Modal.Content t m SavedPayment
view input cancel = do
currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
form <- R.dyn $ do
paymentCategories <- _in_paymentCategories input
payment <- _in_payment input
category <- _in_category input
return . Form.view $ Form.In
{ Form._in_cancel = cancel
, Form._in_headerLabel = Msg.get Msg.Payment_CloneLong
, Form._in_categories = _in_categories input
, Form._in_paymentCategories = paymentCategories
, Form._in_name = _payment_name payment
, Form._in_cost = T.pack . show . _payment_cost $ payment
, Form._in_date = currentDay
, Form._in_category = category
, Form._in_frequency = _payment_frequency payment
, Form._in_mkPayload = CreatePaymentForm
, Form._in_ajax = Ajax.post
}
hide <- ReflexUtil.flatten (Form._output_hide <$> form)
clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> form)
return $
( hide
, clonePayment
)
module View.Payment.Delete
( In(..)
, view
) where
import Data.Text (Text)
import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Payment (..))
import qualified Common.Msg as Msg
import qualified Component.Button as Button
import qualified Component.Modal as Modal
import qualified Util.Ajax as Ajax
import qualified Util.Either as EitherUtil
import qualified Util.WaitFor as WaitFor
data In t = In
{ _in_payment :: Dynamic t Payment
}
view :: forall t m. MonadWidget t m => (In t) -> Modal.Content t m Payment
view input _ =
R.divClass "delete" $ do
R.divClass "deleteHeader" $ R.text $ Msg.get Msg.Payment_DeleteConfirm
R.divClass "deleteContent" $ do
(confirm, cancel) <- R.divClass "buttons" $ do
cancel <- Button._out_clic <$> (Button.view $
(Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
{ Button._in_class = R.constDyn "undo" })
rec
confirm <- Button._out_clic <$> (Button.view $
(Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
{ Button._in_class = R.constDyn "confirm"
, Button._in_submit = True
, Button._in_waiting = waiting
})
let url =
R.ffor (_in_payment input) (\id ->
T.concat ["/api/payment/", T.pack . show $ _payment_id id]
)
(result, waiting) <- WaitFor.waitFor
(Ajax.delete url)
confirm
return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
return $
( R.leftmost [ cancel, () <$ confirm ]
, R.tag (R.current $ _in_payment input) confirm
)
module View.Payment.Edit
( In(..)
, view
) where
import qualified Control.Monad as Monad
import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Category (..), CategoryId,
EditPaymentForm (..), Frequency (..),
Payment (..), PaymentCategory (..),
SavedPayment (..))
import qualified Common.Msg as Msg
import qualified Component.Modal as Modal
import qualified Util.Ajax as Ajax
import qualified Util.Reflex as ReflexUtil
import qualified View.Payment.Form as Form
data In t = In
{ _in_show :: Event t ()
, _in_categories :: [Category]
, _in_paymentCategories :: Dynamic t [PaymentCategory]
, _in_payment :: Dynamic t Payment
, _in_category :: Dynamic t CategoryId
}
view :: forall t m. MonadWidget t m => In t -> Modal.Content t m SavedPayment
view input cancel = do
formOutput <- R.dyn $ do
paymentCategories <- _in_paymentCategories input
payment <- _in_payment input
category <- _in_category input
return . Form.view $ Form.In
{ Form._in_cancel = cancel
, Form._in_headerLabel = Msg.get Msg.Payment_EditLong
, Form._in_categories = _in_categories input
, Form._in_paymentCategories = paymentCategories
, Form._in_name = _payment_name payment
, Form._in_cost = T.pack . show . _payment_cost $ payment
, Form._in_date = _payment_date payment
, Form._in_category = category
, Form._in_frequency = _payment_frequency payment
, Form._in_mkPayload = EditPaymentForm (_payment_id payment)
, Form._in_ajax = Ajax.put
}
hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
editPayment <- ReflexUtil.flatten (Form._output_addPayment <$> formOutput)
return $
( hide
, editPayment
)
module View.Payment.Form
( view
, In(..)
, Out(..)
, Operation(..)
) where
import Data.Aeson (ToJSON)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value)
import qualified Data.Aeson as Aeson
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map as M
......@@ -13,6 +15,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import qualified Data.Time.Calendar as Calendar
import qualified Data.Time.Clock as Clock
import Data.Validation (Validation)
import qualified Data.Validation as V
import Reflex.Dom (Dynamic, Event, MonadWidget)
......@@ -20,103 +23,98 @@ import qualified Reflex.Dom as R
import qualified Text.Read as T
import Common.Model (Category (..), CategoryId,
CreatePaymentForm (..),
EditPaymentForm (..),
Frequency (..), Payment (..),
PaymentCategory (..),
SavedPayment (..))
import qualified Common.Msg as Msg
import qualified Common.Util.Time as TimeUtil
import qualified Common.Validation.Payment as PaymentValidation
import qualified Component.Input as Input
import qualified Component.Modal as Modal
import qualified Component.ModalForm as ModalForm
import qualified Component.Select as Select
import qualified Util.Ajax as Ajax
import qualified Util.Validation as ValidationUtil
data In m t a = In
{ _in_cancel :: Event t ()
, _in_headerLabel :: Text
, _in_categories :: [Category]
data In = In
{ _in_categories :: [Category]
, _in_paymentCategories :: [PaymentCategory]
, _in_name :: Text
, _in_cost :: Text
, _in_date :: Day
, _in_category :: CategoryId
, _in_frequency :: Frequency
, _in_mkPayload :: Text -> Text -> Text -> CategoryId -> Frequency -> a
, _in_ajax :: Text -> Event t a -> m (Event t (Either Text SavedPayment))
, _in_operation :: Operation
}
data Out t = Out
{ _output_hide :: Event t ()
, _output_addPayment :: Event t SavedPayment
}
data Operation
= New Frequency
| Clone Payment
| Edit Payment
view :: forall t m a. (MonadWidget t m, ToJSON a) => In m t a -> m (Out t)
view input = do
view :: forall t m a. MonadWidget t m => In -> Modal.Content t m SavedPayment
view input cancel = do
rec
let reset = R.leftmost
[ "" <$ ModalForm._out_cancel modalForm
, "" <$ ModalForm._out_validate modalForm
, "" <$ _in_cancel input
, "" <$ cancel
]
modalForm <- ModalForm.view $ ModalForm.In
{ ModalForm._in_headerLabel = _in_headerLabel input
, ModalForm._in_ajax = _in_ajax input "/api/payment"
{ ModalForm._in_headerLabel = headerLabel
, ModalForm._in_ajax = ajax "/api/payment"
, ModalForm._in_form = form reset (ModalForm._out_confirm modalForm)
}
return $ Out
{ _output_hide = ModalForm._out_hide modalForm
, _output_addPayment = ModalForm._out_validate modalForm
}
return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm)
where
form
:: Event t String
-> Event t ()
-> m (Dynamic t (Validation (NonEmpty Text) a))
-> m (Dynamic t (Validation (NonEmpty Text) Value))
form reset confirm = do
name <- Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.Payment_Name
, Input._in_initialValue = _in_name input
, Input._in_initialValue = name
, Input._in_validation = PaymentValidation.name
})
(_in_name input <$ reset)
(name <$ reset)
confirm
cost <- Input._out_raw <$> (Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.Payment_Cost
, Input._in_initialValue = _in_cost input
, Input._in_initialValue = cost
, Input._in_validation = PaymentValidation.cost
})
(_in_cost input <$ reset)
(cost <$ reset)
confirm)
let initialDate = T.pack . Calendar.showGregorian . _in_date $ input
d <- date
date <- Input._out_raw <$> (Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.Payment_Date
, Input._in_initialValue = initialDate
, Input._in_initialValue = d
, Input._in_inputType = "date"
, Input._in_hasResetButton = False
, Input._in_validation = PaymentValidation.date
})
(initialDate <$ reset)
(d <$ reset)
confirm)
let setCategory =
R.fmapMaybe id . R.updated $
R.ffor (Input._out_raw name) $ \name ->
findCategory name (_in_paymentCategories input)
R.ffor (Input._out_raw name) findCategory
category <- Select._out_value <$> (Select.view $ Select.In
{ Select._in_label = Msg.get Msg.Payment_Category
, Select._in_initialValue = _in_category input
, Select._in_initialValue = category
, Select._in_value = setCategory
, Select._in_values = R.constDyn categories
, Select._in_reset = _in_category input <$ reset
, Select._in_reset = category <$ reset
, Select._in_isValid = PaymentValidation.category (map _category_id $ _in_categories input)
, Select._in_validate = confirm
})
......@@ -126,12 +124,12 @@ view input = do
c <- cost
d <- date
cat <- category
return ((_in_mkPayload input)
return (mkPayload
<$> ValidationUtil.nelError n
<*> V.Success c
<*> V.Success d
<*> ValidationUtil.nelError cat
<*> V.Success (_in_frequency input))
<*> V.Success frequency)
frequencies =
M.fromList
......@@ -142,7 +140,58 @@ view input = do
categories = M.fromList . flip map (_in_categories input) $ \c ->
(_category_id c, _category_name c)
findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
findCategory paymentName =
fmap _paymentCategory_category
. L.find ((==) (T.toLower paymentName) . _paymentCategory_name)
op = _in_operation input
name =
case op of
New _ -> ""
Clone p -> _payment_name p
Edit p -> _payment_name p
cost =
case op of
New _ -> ""
Clone p -> T.pack . show . _payment_cost $ p
Edit p -> T.pack . show . _payment_cost $ p
date = do
currentDay <- liftIO $ Clock.getCurrentTime >>= TimeUtil.timeToDay
return . T.pack . Calendar.showGregorian $
case op of
New _ -> currentDay
Clone p -> currentDay
Edit p -> _payment_date p
category =
case op of
New _ -> -1
Clone p -> Maybe.fromMaybe (-1) $ findCategory (_payment_name p)
Edit p -> Maybe.fromMaybe (-1) $ findCategory (_payment_name p)
frequency =
case op of
New f -> f
Clone p -> _payment_frequency p
Edit p -> _payment_frequency p
headerLabel =
case op of
New _ -> Msg.get Msg.Payment_Add
Clone _ -> Msg.get Msg.Payment_CloneLong
Edit _ -> Msg.get Msg.Payment_EditLong
ajax =
case op of
Edit _ -> Ajax.put
_ -> Ajax.post
mkPayload =
case op of
Edit p -> \a b c d e -> Aeson.toJSON $ EditPaymentForm (_payment_id p) a b c d e
_ -> \a b c d e -> Aeson.toJSON $ CreatePaymentForm a b c d e
findCategory :: Text -> Maybe CategoryId
findCategory paymentName =
fmap _paymentCategory_category
. L.find ((==) (T.toLower paymentName) . _paymentCategory_name)
$ (_in_paymentCategories input)
......@@ -32,7 +32,7 @@ import qualified Component.Input as Input
import qualified Component.Modal as Modal
import qualified Component.Select as Select
import qualified Util.List as L
import qualified View.Payment.Add as Add
import qualified View.Payment.Form as Form
import View.Payment.Init (Init (..))
data In t = In
......@@ -120,11 +120,7 @@ payerAndAdd incomes payments users categories paymentCategories currency frequen
Modal.view $ Modal.In
{ Modal._in_show = addPayment
, Modal._in_content = Add.view $ Add.In
{ Add._in_categories = categories
, Add._in_paymentCategories = paymentCategories
, Add._in_frequency = frequency
}
, Modal._in_content = \_ -> return (R.never, R.never) -- TODO
}
searchLine
......
module View.Payment.Pages
( view
, In(..)
, Out(..)
) where
import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import qualified Component.Button as Button
import qualified Util.Reflex as ReflexUtil
import qualified View.Icon as Icon
data In t = In
{ _in_total :: Dynamic t Int
, _in_perPage :: Int
, _in_reset :: Event t ()
}
data Out t = Out
{ _out_currentPage :: Dynamic t Int
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
view input = do
currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
return $ Out
{ _out_currentPage = currentPage
}
where
total = _in_total input
perPage = _in_perPage input
reset = _in_reset input
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