From 11052951b74b9ad4b6a9412ae490086235f9154b Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Jan 2021 13:40:40 +0100 Subject: Rewrite in Rust --- client/src/View/Income/Form.hs | 119 -------------------------------------- client/src/View/Income/Header.hs | 77 ------------------------ client/src/View/Income/Income.hs | 75 ------------------------ client/src/View/Income/Reducer.hs | 59 ------------------- client/src/View/Income/Table.hs | 93 ----------------------------- 5 files changed, 423 deletions(-) delete mode 100644 client/src/View/Income/Form.hs delete mode 100644 client/src/View/Income/Header.hs delete mode 100644 client/src/View/Income/Income.hs delete mode 100644 client/src/View/Income/Reducer.hs delete mode 100644 client/src/View/Income/Table.hs (limited to 'client/src/View/Income') diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs deleted file mode 100644 index 59f6a0d..0000000 --- a/client/src/View/Income/Form.hs +++ /dev/null @@ -1,119 +0,0 @@ -module View.Income.Form - ( view - , In(..) - , Operation(..) - ) where - -import Control.Monad.IO.Class (liftIO) -import Data.Aeson (Value) -import qualified Data.Aeson as Aeson -import qualified Data.Maybe as Maybe -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Time.Calendar as Calendar -import qualified Data.Time.Clock as Time -import Data.Validation (Validation) -import qualified Data.Validation as V -import Reflex.Dom (Dynamic, Event, MonadWidget) -import qualified Reflex.Dom as R - -import Common.Model (CreateIncomeForm (..), - EditIncomeForm (..), Income (..)) -import qualified Common.Msg as Msg -import qualified Common.Util.Time as TimeUtil -import qualified Common.Validation.Income as IncomeValidation -import qualified Component.Input as Input -import qualified Component.Modal as Modal -import qualified Component.ModalForm as ModalForm -import qualified Util.Ajax as Ajax - -data In = In - { _in_operation :: Operation - } - -data Operation - = New - | Clone Income - | Edit Income - -view :: forall t m a. MonadWidget t m => In -> Modal.Content t m -view input cancel = do - - rec - let reset = R.leftmost - [ "" <$ ModalForm._out_cancel modalForm - , "" <$ ModalForm._out_validate modalForm - , "" <$ cancel - ] - - modalForm <- ModalForm.view $ ModalForm.In - { ModalForm._in_headerLabel = headerLabel - , ModalForm._in_ajax = ajax "/api/income" - , ModalForm._in_form = form reset (ModalForm._out_confirm modalForm) - } - - return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm) - - where - - form - :: Event t String - -> Event t () - -> m (Dynamic t (Validation Text Value)) - form reset confirm = do - amount <- Input._out_raw <$> (Input.view - (Input.defaultIn - { Input._in_label = Msg.get Msg.Income_Amount - , Input._in_initialValue = amount - , Input._in_validation = IncomeValidation.amount - }) - (amount <$ reset) - confirm) - - currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay - - let initialDate = T.pack . Calendar.showGregorian $ date currentDay - - date <- Input._out_raw <$> (Input.view - (Input.defaultIn - { Input._in_label = Msg.get Msg.Income_Date - , Input._in_initialValue = initialDate - , Input._in_inputType = "date" - , Input._in_hasResetButton = False - , Input._in_validation = IncomeValidation.date - }) - (initialDate <$ reset) - confirm) - - return $ do - a <- amount - d <- date - return . V.Success $ mkPayload a d - - op = _in_operation input - - amount = - case op of - New -> "" - Clone i -> T.pack . show . _income_amount $ i - Edit i -> T.pack . show . _income_amount $ i - - date currentDay = - case op of - Edit i -> _income_date i - _ -> currentDay - - ajax = - case op of - Edit _ -> Ajax.put - _ -> Ajax.post - - headerLabel = - case op of - Edit _ -> Msg.get Msg.Income_Edit - _ -> Msg.get Msg.Income_AddLong - - mkPayload = - case op of - Edit i -> \a b -> Aeson.toJSON $ EditIncomeForm (_income_id i) a b - _ -> \a b -> Aeson.toJSON $ CreateIncomeForm a b diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs deleted file mode 100644 index a26e16a..0000000 --- a/client/src/View/Income/Header.hs +++ /dev/null @@ -1,77 +0,0 @@ -module View.Income.Header - ( view - , In(..) - , Out(..) - ) where - -import Control.Monad.IO.Class (liftIO) -import qualified Data.Map as M -import qualified Data.Maybe as Maybe -import qualified Data.Text as T -import qualified Data.Time.Clock as Clock -import Reflex.Dom (Dynamic, Event, MonadWidget) -import qualified Reflex.Dom as R - -import Common.Model (Currency, Income (..), - IncomeHeader (..), User (..)) -import qualified Common.Model as CM -import qualified Common.Msg as Msg -import qualified Common.View.Format as Format - -import qualified Component.Button as Button -import qualified Component.Modal as Modal -import qualified View.Income.Form as Form - -data In t = In - { _in_users :: [User] - , _in_header :: IncomeHeader - , _in_currency :: Currency - } - -data Out t = Out - { _out_add :: Event t () - } - -view :: forall t m. MonadWidget t m => In t -> m (Out t) -view input = - R.divClass "withMargin" $ do - - currentTime <- liftIO Clock.getCurrentTime - - case _incomeHeader_since $ _in_header input of - Nothing -> - R.blank - - Just since -> - R.el "div" $ do - - R.el "h1" $ do - R.text $ Msg.get (Msg.Income_CumulativeSince (Format.longDay since)) - - R.el "ul" $ - flip mapM_ (M.toList . _incomeHeader_byUser $ _in_header input) $ \(userId, amount) -> - R.el "li" $ - R.text $ - T.intercalate " " - [ Maybe.fromMaybe "" . fmap _user_name $ CM.findUser userId (_in_users input) - , "−" - , Format.price (_in_currency input) amount - ] - - R.divClass "titleButton" $ do - R.el "h1" $ - R.text $ - Msg.get Msg.Income_MonthlyNet - - addIncome <- Button._out_clic <$> - (Button.view . Button.defaultIn . R.text $ - Msg.get Msg.Income_AddLong) - - addIncome <- Modal.view $ Modal.In - { Modal._in_show = addIncome - , Modal._in_content = Form.view $ Form.In { Form._in_operation = Form.New } - } - - return $ Out - { _out_add = addIncome - } diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs deleted file mode 100644 index 7be8091..0000000 --- a/client/src/View/Income/Income.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE ExplicitForAll #-} - -module View.Income.Income - ( view - , In(..) - ) where - -import Data.Aeson (FromJSON) -import qualified Data.Maybe as Maybe -import qualified Data.Text as T -import Reflex.Dom (Dynamic, Event, MonadWidget) -import qualified Reflex.Dom as R - -import Common.Model (Currency, Income (..), IncomePage (..), - User, UserId) - -import qualified Component.Pages as Pages -import Loadable (Loadable (..)) -import qualified Loadable -import qualified Util.Ajax as AjaxUtil -import qualified Util.Reflex as ReflexUtil -import qualified Util.Reflex as ReflexUtil -import qualified View.Income.Header as Header -import qualified View.Income.Reducer as Reducer -import qualified View.Income.Table as Table - -data In t = In - { _in_users :: [User] - , _in_currentUser :: UserId - , _in_currency :: Currency - } - -view :: forall t m. MonadWidget t m => In t -> m () -view input = do - rec - incomePage <- Reducer.reducer $ Reducer.In - { Reducer._in_page = page - , Reducer._in_addIncome = R.leftmost [headerAddIncome, tableAddIncome] - , Reducer._in_editIncome = editIncome - , Reducer._in_deleteIncome = deleteIncome - } - - let eventFromResult :: forall a. ((Header.Out t, Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a) - eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result - - page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c) - headerAddIncome <- eventFromResult $ Header._out_add . (\(a, _, _) -> a) - tableAddIncome <- eventFromResult $ Table._out_add . (\(_, b, _) -> b) - editIncome <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b) - deleteIncome <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b) - - result <- Loadable.viewShowValueWhileLoading incomePage $ - \(IncomePage page header incomes count) -> do - header <- Header.view $ Header.In - { Header._in_users = _in_users input - , Header._in_header = header - , Header._in_currency = _in_currency input - } - - table <- Table.view $ Table.In - { Table._in_currentUser = _in_currentUser input - , Table._in_currency = _in_currency input - , Table._in_incomes = incomes - , Table._in_users = _in_users input - } - - pages <- Pages.view $ Pages.In - { Pages._in_total = R.constDyn count - , Pages._in_perPage = Reducer.perPage - , Pages._in_page = page - } - - return (header, table, pages) - - return () diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs deleted file mode 100644 index ea9f664..0000000 --- a/client/src/View/Income/Reducer.hs +++ /dev/null @@ -1,59 +0,0 @@ -module View.Income.Reducer - ( perPage - , reducer - , In(..) - ) 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 (IncomePage) - -import Loadable (Loadable (..)) -import qualified Loadable as Loadable -import qualified Util.Ajax as AjaxUtil -import qualified Util.Either as EitherUtil - -perPage :: Int -perPage = 7 - -data In t a b c = In - { _in_page :: Event t Int - , _in_addIncome :: Event t a - , _in_editIncome :: Event t b - , _in_deleteIncome :: Event t c - } - -reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomePage)) -reducer input = do - - postBuild <- R.getPostBuild - - currentPage <- R.holdDyn 1 (_in_page input) - - let loadPage = - R.leftmost - [ 1 <$ postBuild - , _in_page input - , 1 <$ _in_addIncome input - , R.tag (R.current currentPage) (_in_editIncome input) - , R.tag (R.current currentPage) (_in_deleteIncome input) - ] - - getResult <- AjaxUtil.get $ fmap pageUrl loadPage - - R.holdDyn - Loading - (R.leftmost - [ Loading <$ loadPage - , Loadable.fromEither <$> getResult - ]) - - where - pageUrl p = - "api/incomes?page=" - <> (T.pack . show $ p) - <> "&perPage=" - <> (T.pack . show $ perPage) diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs deleted file mode 100644 index 7b7940d..0000000 --- a/client/src/View/Income/Table.hs +++ /dev/null @@ -1,93 +0,0 @@ -module View.Income.Table - ( view - , In(..) - , Out(..) - ) where - -import qualified Data.Maybe as Maybe -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 (Currency, Income (..), User (..), - UserId) -import qualified Common.Model as CM -import qualified Common.Msg as Msg -import qualified Common.View.Format as Format - -import qualified Component.ConfirmDialog as ConfirmDialog -import qualified Component.Table as Table -import qualified Util.Ajax as Ajax -import qualified Util.Either as EitherUtil -import qualified View.Income.Form as Form - -data In t = In - { _in_currentUser :: UserId - , _in_currency :: Currency - , _in_incomes :: [Income] - , _in_users :: [User] - } - -data Out t = Out - { _out_add :: Event t () - , _out_edit :: Event t () - , _out_delete :: Event t () - } - -view :: forall t m. MonadWidget t m => In t -> m (Out t) -view input = do - - table <- Table.view $ Table.In - { Table._in_headerLabel = headerLabel - , Table._in_rows = _in_incomes input - , Table._in_cell = cell (_in_users input) (_in_currency input) - , Table._in_cloneModal = \income -> - Form.view $ Form.In - { Form._in_operation = Form.Clone income - } - , Table._in_editModal = \income -> - Form.view $ Form.In - { Form._in_operation = Form.Edit income - } - , Table._in_deleteModal = \income -> - ConfirmDialog.view $ ConfirmDialog.In - { ConfirmDialog._in_header = Msg.get Msg.Income_DeleteConfirm - , ConfirmDialog._in_confirm = \e -> do - res <- Ajax.delete - (R.constDyn $ T.concat ["/api/income/", T.pack . show $ _income_id income]) - e - return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res - } - , Table._in_canEdit = (== (_in_currentUser input)) . _income_userId - , Table._in_canDelete = (== (_in_currentUser input)) . _income_userId - } - - return $ Out - { _out_add = Table._out_add table - , _out_edit = Table._out_edit table - , _out_delete = Table._out_delete table - } - -data Header - = UserHeader - | AmountHeader - | DateHeader - deriving (Eq, Show, Bounded, Enum) - -headerLabel :: Header -> Text -headerLabel UserHeader = Msg.get Msg.Income_Name -headerLabel DateHeader = Msg.get Msg.Income_Date -headerLabel AmountHeader = Msg.get Msg.Income_Amount - -cell :: forall t m. MonadWidget t m => [User] -> Currency -> Header -> Income -> m () -cell users currency header income = - case header of - UserHeader -> - R.text . Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users - - DateHeader -> - R.text . Format.longDay . _income_date $ income - - AmountHeader -> - R.text . Format.price currency . _income_amount $ income -- cgit v1.2.3