From 61ff1443c42def5a09f624e3df2e2520e97610d0 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 22 Oct 2019 23:25:05 +0200 Subject: Clone incomes --- client/src/Component/Table.hs | 54 +++++++++++++++++++++++++++++----------- client/src/View/Income/Add.hs | 20 ++++++++++----- client/src/View/Income/Header.hs | 2 +- client/src/View/Income/Income.hs | 17 +++++++------ client/src/View/Income/Table.hs | 32 ++++++++++++++++-------- client/src/View/Payment/Clone.hs | 6 ++--- 6 files changed, 90 insertions(+), 41 deletions(-) (limited to 'client/src') diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs index bf76566..5819f45 100644 --- a/client/src/Component/Table.hs +++ b/client/src/Component/Table.hs @@ -4,56 +4,82 @@ module Component.Table , Out(..) ) where -import Data.Text (Text) -import Reflex.Dom (Dynamic, Event, MonadWidget) -import qualified Reflex.Dom as R +import Data.Text (Text) +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R -import qualified Component.Pages as Pages +import qualified Component.Button as Button +import qualified Component.Modal as Modal +import qualified Component.Pages as Pages +import qualified Util.Reflex as ReflexUtil +import qualified View.Icon as Icon -data In h r t = In +data In m t h r a = In { _in_headerLabel :: h -> Text , _in_rows :: Dynamic t [r] , _in_cell :: h -> r -> Text , _in_perPage :: Int , _in_resetPage :: Event t () + , _in_cloneModal :: Dynamic t r -> Modal.Content t m a } -data Out = Out - {} +data Out t a = Out + { _out_add :: Event t a + } -view :: forall t m h r. (MonadWidget t m, Bounded h, Enum h) => In h r t -> m (Out) +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 input = R.divClass "table" $ do rec - R.divClass "lines" $ do + result <- R.divClass "lines" $ do - R.divClass "header" $ + R.divClass "header" $ do flip mapM_ [minBound..] $ \header -> R.divClass "cell" . R.text $ _in_headerLabel input header + R.divClass "cell" $ R.blank + let rows = getRange (_in_perPage input) <$> (Pages._out_currentPage pages) <*> (_in_rows input) R.simpleList rows $ \r -> - R.divClass "row" $ + R.divClass "row" $ do flip mapM_ [minBound..] $ \h -> - R.divClass "cell name" $ + R.divClass "cell" $ R.dynText $ R.ffor r (_in_cell input h) + clone <- + R.divClass "cell button" $ + Button._out_clic <$> (Button.view $ + Button.defaultIn Icon.clone) + + cloned <- + Modal.view $ Modal.In + { Modal._in_show = clone + , Modal._in_content = _in_cloneModal input r + } + + return cloned + pages <- Pages.view $ Pages.In { Pages._in_total = length <$> (_in_rows input) , Pages._in_perPage = _in_perPage input , Pages._in_reset = _in_resetPage input } - return () + -- return $ + -- ( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result + -- , R.switch . R.current . fmap (R.leftmost . map (\(_, b, _) -> b)) $ result + -- , R.switch . R.current . fmap (R.leftmost . map (\(_, _, c) -> c)) $ result + -- ) return $ Out - {} + { _out_add = R.switch . R.current . fmap R.leftmost $ result + } getRange :: forall a. Int -> Int -> [a] -> [a] getRange perPage currentPage = diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs index f8f107f..d07bd45 100644 --- a/client/src/View/Income/Add.hs +++ b/client/src/View/Income/Add.hs @@ -1,13 +1,16 @@ module View.Income.Add ( view + , In(..) ) 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 Time -import Reflex.Dom (MonadWidget) +import Reflex.Dom (Dynamic, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (CreateIncomeForm (..), Income) +import Common.Model (CreateIncomeForm (..), Income (..)) import qualified Common.Msg as Msg import qualified Common.Util.Time as TimeUtil import qualified Component.Modal as Modal @@ -15,16 +18,21 @@ import qualified Util.Ajax as Ajax import qualified Util.Reflex as ReflexUtil import qualified View.Income.Form as Form -view :: forall t m. MonadWidget t m => Modal.Content t m Income -view cancel = do +data In t = In + { _in_income :: Dynamic t (Maybe Income) + } + +view :: forall t m. MonadWidget t m => In t -> Modal.Content t m Income +view input cancel = do currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay - form <- R.dyn $ + form <- R.dyn $ do + income <- _in_income input return $ Form.view $ Form.In { Form._in_cancel = cancel , Form._in_headerLabel = Msg.get Msg.Income_AddLong - , Form._in_amount = "" + , Form._in_amount = Maybe.fromMaybe "" ((T.pack . show . _income_amount) <$> income) , Form._in_date = currentDay , Form._in_mkPayload = CreateIncomeForm , Form._in_ajax = Ajax.post diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs index ae1174a..0360d1f 100644 --- a/client/src/View/Income/Header.hs +++ b/client/src/View/Income/Header.hs @@ -72,7 +72,7 @@ view input = addIncome <- Modal.view $ Modal.In { Modal._in_show = addIncome - , Modal._in_content = Add.view + , Modal._in_content = Add.view $ Add.In { Add._in_income = R.constDyn Nothing } } return $ Out diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index f8359bb..b97613d 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -41,11 +41,14 @@ view input = do R.elClass "main" "income" $ do rec - + let addIncome = R.leftmost + [ Header._out_addIncome header + , Table._out_addIncome table + ] incomes <- R.foldDyn (:) (_init_incomes init) - (Header._out_addIncome header) + addIncome header <- Header.view $ Header.In { Header._in_init = init @@ -53,11 +56,11 @@ view input = do , Header._in_incomes = incomes } - Table.view $ Table.In - { Table._in_init = init - , Table._in_currency = _in_currency input - , Table._in_incomes = incomes - } + table <- Table.view $ Table.In + { Table._in_init = init + , Table._in_currency = _in_currency input + , Table._in_incomes = incomes + } return () diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs index 9cb705f..358cb17 100644 --- a/client/src/View/Income/Table.hs +++ b/client/src/View/Income/Table.hs @@ -1,12 +1,13 @@ module View.Income.Table ( view , In(..) + , Out(..) ) where import qualified Data.List as L import qualified Data.Maybe as Maybe import Data.Text (Text) -import Reflex.Dom (Dynamic, MonadWidget) +import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R import Common.Model (Currency, Income (..), User (..)) @@ -15,6 +16,7 @@ import qualified Common.Msg as Msg import qualified Common.View.Format as Format import qualified Component.Table as Table +import qualified View.Income.Add as Add import View.Income.Init (Init (..)) data In t = In @@ -23,18 +25,28 @@ data In t = In , _in_incomes :: Dynamic t [Income] } -view :: forall t m. MonadWidget t m => In t -> m () +data Out t = Out + { _out_addIncome :: Event t Income + } + +view :: forall t m. MonadWidget t m => In t -> m (Out t) view input = do - Table.view $ Table.In - { Table._in_headerLabel = headerLabel - , Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date - , Table._in_cell = cell (_in_init input) (_in_currency input) - , Table._in_perPage = 7 - , Table._in_resetPage = R.never - } + table <- Table.view $ Table.In + { Table._in_headerLabel = headerLabel + , Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date + , Table._in_cell = cell (_in_init input) (_in_currency input) + , Table._in_perPage = 7 + , Table._in_resetPage = R.never + , Table._in_cloneModal = \income -> + Add.view $ Add.In + { Add._in_income = Just <$> income + } + } - return () + return $ Out + { _out_addIncome = Table._out_add table + } data Header = UserHeader diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs index 56a33d9..82b0c27 100644 --- a/client/src/View/Payment/Clone.hs +++ b/client/src/View/Payment/Clone.hs @@ -34,7 +34,7 @@ view input cancel = do currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay - formOutput <- R.dyn $ do + form <- R.dyn $ do paymentCategories <- _in_paymentCategories input payment <- _in_payment input category <- _in_category input @@ -52,8 +52,8 @@ view input cancel = do , Form._in_ajax = Ajax.post } - hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput) - clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> formOutput) + hide <- ReflexUtil.flatten (Form._output_hide <$> form) + clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> form) return $ ( hide -- cgit v1.2.3