diff options
Diffstat (limited to 'client/src/View/Income')
| -rw-r--r-- | client/src/View/Income/Add.hs | 36 | ||||
| -rw-r--r-- | client/src/View/Income/Form.hs | 113 | ||||
| -rw-r--r-- | client/src/View/Income/Header.hs | 55 | ||||
| -rw-r--r-- | client/src/View/Income/Income.hs | 21 | ||||
| -rw-r--r-- | client/src/View/Income/Table.hs | 17 |
5 files changed, 212 insertions, 30 deletions
diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs new file mode 100644 index 0000000..d83bb51 --- /dev/null +++ b/client/src/View/Income/Add.hs @@ -0,0 +1,36 @@ +module View.Income.Add + ( view + ) where + +import Control.Monad.IO.Class (liftIO) +import qualified Data.Time.Clock as Time +import Reflex.Dom (MonadWidget) +import qualified Reflex.Dom as R + +import Common.Model (CreateIncomeForm (..), Income) +import qualified Common.Msg as Msg +import qualified Common.Util.Time as TimeUtil +import qualified Component.Modal as Modal +import qualified Util.Reflex as ReflexUtil +import View.Income.Form (FormIn (..), FormOut (..)) +import qualified View.Income.Form as Form + +view :: forall t m. MonadWidget t m => Modal.Content t m Income +view cancel = do + + currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay + + form <- R.dyn $ + return $ Form.view $ FormIn + { _formIn_cancel = cancel + , _formIn_headerLabel = Msg.get Msg.Income_AddLong + , _formIn_amount = "" + , _formIn_date = currentDay + , _formIn_mkPayload = CreateIncomeForm + , _formIn_httpMethod = Form.Post + } + + hide <- ReflexUtil.flatten (_formOut_hide <$> form) + addIncome <- ReflexUtil.flatten (_formOut_addIncome <$> form) + + return (hide, addIncome) diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs new file mode 100644 index 0000000..b8a9094 --- /dev/null +++ b/client/src/View/Income/Form.hs @@ -0,0 +1,113 @@ +module View.Income.Form + ( view + , FormIn(..) + , HttpMethod(..) + , FormOut(..) + ) where + +import Data.Aeson (ToJSON) +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.Validation as V +import Reflex.Dom (Event, MonadWidget) +import qualified Reflex.Dom as R + +import Common.Model (Income) +import qualified Common.Msg as Msg +import qualified Common.Validation.Income as IncomeValidation +import Component (ButtonIn (..), InputIn (..), + InputOut (..)) +import qualified Component as Component +import qualified Util.Ajax as Ajax +import qualified Util.Either as EitherUtil +import qualified Util.Validation as ValidationUtil +import qualified Util.WaitFor as WaitFor + +data FormIn t i = FormIn + { _formIn_cancel :: Event t () + , _formIn_headerLabel :: Text + , _formIn_amount :: Text + , _formIn_date :: Day + , _formIn_mkPayload :: Text -> Text -> i + , _formIn_httpMethod :: HttpMethod + } + +data HttpMethod = Put | Post + +data FormOut t = FormOut + { _formOut_hide :: Event t () + , _formOut_addIncome :: Event t Income + } + +view :: forall t m i. (MonadWidget t m, ToJSON i) => FormIn t i -> m (FormOut t) +view formIn = do + R.divClass "form" $ do + R.divClass "formHeader" $ + R.text (_formIn_headerLabel formIn) + + R.divClass "formContent" $ do + rec + let reset = R.leftmost + [ "" <$ cancel + , "" <$ addIncome + , "" <$ _formIn_cancel formIn + ] + + amount <- _inputOut_raw <$> (Component.input + (Component.defaultInputIn + { _inputIn_label = Msg.get Msg.Income_Amount + , _inputIn_initialValue = _formIn_amount formIn + , _inputIn_validation = IncomeValidation.amount + }) + (_formIn_amount formIn <$ reset) + confirm) + + let initialDate = T.pack . Calendar.showGregorian . _formIn_date $ formIn + + date <- _inputOut_raw <$> (Component.input + (Component.defaultInputIn + { _inputIn_label = Msg.get Msg.Income_Date + , _inputIn_initialValue = initialDate + , _inputIn_inputType = "date" + , _inputIn_hasResetButton = False + , _inputIn_validation = IncomeValidation.date + }) + (initialDate <$ reset) + confirm) + + let income = do + a <- amount + d <- date + return . V.Success $ (_formIn_mkPayload formIn) a d + + (addIncome, cancel, confirm) <- R.divClass "buttons" $ do + rec + cancel <- Component._buttonOut_clic <$> (Component.button $ + (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo)) + { _buttonIn_class = R.constDyn "undo" }) + + confirm <- Component._buttonOut_clic <$> (Component.button $ + (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm)) + { _buttonIn_class = R.constDyn "confirm" + , _buttonIn_waiting = waiting + , _buttonIn_submit = True + }) + + (addIncome, waiting) <- WaitFor.waitFor + (ajax "/api/income") + (ValidationUtil.fireValidation income confirm) + + return (R.fmapMaybe EitherUtil.eitherToMaybe addIncome, cancel, confirm) + + return FormOut + { _formOut_hide = R.leftmost [ cancel, () <$ addIncome ] + , _formOut_addIncome = addIncome + } + + where + ajax = + case _formIn_httpMethod formIn of + Post -> Ajax.postJson + Put -> Ajax.putJson diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs index b7170c9..e384161 100644 --- a/client/src/View/Income/Header.hs +++ b/client/src/View/Income/Header.hs @@ -1,33 +1,46 @@ module View.Income.Header ( view , HeaderIn(..) + , HeaderOut(..) ) where import Control.Monad.IO.Class (liftIO) import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Time.Clock as Clock -import Reflex.Dom (MonadWidget) +import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R import Common.Model (Income (..), Init (..), User (..)) import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Common.View.Format as Format +import Component (ButtonOut (..)) +import qualified Component +import qualified Component.Modal as Modal import qualified Util.Date as DateUtil +import qualified View.Income.Add as Add -data HeaderIn = HeaderIn - { _headerIn_init :: Init +data HeaderIn t = HeaderIn + { _headerIn_init :: Init + , _headerIn_incomes :: Dynamic t [Income] } -view :: forall t m. MonadWidget t m => HeaderIn -> m () +data HeaderOut t = HeaderOut + { _headerOut_addIncome :: Event t Income + } + +view :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t) view headerIn = R.divClass "withMargin" $ do currentTime <- liftIO Clock.getCurrentTime - Maybe.fromMaybe R.blank $ - flip fmap useIncomesFrom $ \since -> + R.dyn . R.ffor useIncomesFrom $ \case + (Nothing, _) -> + R.blank + + (Just since, incomes) -> R.el "div" $ do R.el "h1" $ do @@ -38,23 +51,39 @@ view headerIn = flip mapM_ (_init_users init) $ \user -> R.el "li" $ R.text $ do - let incomes = filter ((==) (_user_id user) . _income_userId) (_init_incomes init) + let userIncomes = filter ((==) (_user_id user) . _income_userId) incomes T.intercalate " " [ _user_name user , "−" , Format.price (_init_currency init) $ - CM.cumulativeIncomesSince currentTime since incomes + CM.cumulativeIncomesSince currentTime since userIncomes ] - R.divClass "titleButton" $ + R.divClass "titleButton" $ do R.el "h1" $ R.text $ Msg.get Msg.Income_MonthlyNet + addIncome <- _buttonOut_clic <$> + (Component.button . Component.defaultButtonIn . R.text $ + Msg.get Msg.Income_AddLong) + + addIncome <- Modal.view $ Modal.Input + { Modal._input_show = addIncome + , Modal._input_content = Add.view + } + + return $ HeaderOut + { _headerOut_addIncome = addIncome + } + where init = _headerIn_init headerIn - useIncomesFrom = CM.useIncomesFrom - (map _user_id $_init_users init) - (_init_incomes init) - (_init_payments init) + useIncomesFrom = R.ffor (_headerIn_incomes headerIn) $ \incomes -> + ( CM.useIncomesFrom + (map _user_id $_init_users init) + incomes + (_init_payments init) + , incomes + ) diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index b0c6f0b..167aedf 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -3,11 +3,11 @@ module View.Income.Income , IncomeIn(..) ) where -import Reflex.Dom (MonadWidget) +import Reflex.Dom (Dynamic, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Init) -import View.Income.Header (HeaderIn (..)) +import Common.Model (Init (..)) +import View.Income.Header (HeaderIn (..), HeaderOut (..)) import qualified View.Income.Header as Header import View.Income.Table (IncomeTableIn (..)) import qualified View.Income.Table as Table @@ -20,12 +20,21 @@ view :: forall t m. MonadWidget t m => IncomeIn -> m () view incomeIn = R.elClass "main" "income" $ do - Header.view $ HeaderIn - { _headerIn_init = _incomeIn_init incomeIn - } + rec + + incomes <- R.foldDyn + (:) + (_init_incomes . _incomeIn_init $ incomeIn) + (_headerOut_addIncome header) + + header <- Header.view $ HeaderIn + { _headerIn_init = _incomeIn_init incomeIn + , _headerIn_incomes = incomes + } Table.view $ IncomeTableIn { _tableIn_init = _incomeIn_init incomeIn + , _tableIn_incomes = incomes } return () diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs index 2e8f4e6..5363ca5 100644 --- a/client/src/View/Income/Table.hs +++ b/client/src/View/Income/Table.hs @@ -6,7 +6,7 @@ module View.Income.Table import qualified Data.List as L import qualified Data.Maybe as Maybe import Data.Text (Text) -import Reflex.Dom (MonadWidget) +import Reflex.Dom (Dynamic, MonadWidget) import qualified Reflex.Dom as R import Common.Model (Income (..), Init (..), User (..)) @@ -16,22 +16,17 @@ import qualified Common.View.Format as Format import Component (TableIn (..)) import qualified Component -data IncomeTableIn = IncomeTableIn - { _tableIn_init :: Init +data IncomeTableIn t = IncomeTableIn + { _tableIn_init :: Init + , _tableIn_incomes :: Dynamic t [Income] } -view :: forall t m. MonadWidget t m => IncomeTableIn -> m () +view :: forall t m. MonadWidget t m => IncomeTableIn t -> m () view tableIn = do Component.table $ TableIn { _tableIn_headerLabel = headerLabel - , _tableIn_rows = - R.constDyn - . reverse - . L.sortOn _income_date - . _init_incomes - . _tableIn_init - $ tableIn + , _tableIn_rows = R.ffor (_tableIn_incomes tableIn) $ reverse . L.sortOn _income_date , _tableIn_cell = cell (_tableIn_init tableIn) , _tableIn_perPage = 7 , _tableIn_resetPage = R.never |