From 7aadcc97f9df0e2daccbe8a8726d8bc6c63d67f4 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 20 Oct 2019 12:02:21 +0200 Subject: Add income --- ISSUES.md | 2 +- client/client.cabal | 2 + client/src/Component.hs | 1 - client/src/View/Income/Add.hs | 36 +++++++++ client/src/View/Income/Form.hs | 113 ++++++++++++++++++++++++++++ client/src/View/Income/Header.hs | 55 ++++++++++---- client/src/View/Income/Income.hs | 21 ++++-- client/src/View/Income/Table.hs | 17 ++--- client/src/View/Payment/Delete.hs | 1 + client/src/View/Payment/Header.hs | 14 ++-- common/common.cabal | 4 +- common/src/Common/Model.hs | 3 +- common/src/Common/Model/CreateIncome.hs | 14 ---- common/src/Common/Model/CreateIncomeForm.hs | 15 ++++ common/src/Common/Model/EditIncomeForm.hs | 18 +++++ common/src/Common/Validation/Income.hs | 17 +++++ common/src/Common/Validation/Payment.hs | 1 - server/server.cabal | 3 + server/src/Controller/Income.hs | 23 ++++-- server/src/Model/CreateIncome.hs | 10 +++ server/src/Model/EditIncome.hs | 13 ++++ server/src/Persistence/Income.hs | 19 +++-- server/src/Validation/Income.hs | 27 +++++++ 23 files changed, 361 insertions(+), 68 deletions(-) create mode 100644 client/src/View/Income/Add.hs create mode 100644 client/src/View/Income/Form.hs delete mode 100644 common/src/Common/Model/CreateIncome.hs create mode 100644 common/src/Common/Model/CreateIncomeForm.hs create mode 100644 common/src/Common/Model/EditIncomeForm.hs create mode 100644 common/src/Common/Validation/Income.hs create mode 100644 server/src/Model/CreateIncome.hs create mode 100644 server/src/Model/EditIncome.hs create mode 100644 server/src/Validation/Income.hs diff --git a/ISSUES.md b/ISSUES.md index 04fdf2f..56f158d 100644 --- a/ISSUES.md +++ b/ISSUES.md @@ -1,6 +1,6 @@ ## Income view -- Add an income +- Take into account modified incomes into payment table - Clone an income - Edit an income - Remove an income diff --git a/client/client.cabal b/client/client.cabal index 06e77e0..bfcfc59 100644 --- a/client/client.cabal +++ b/client/client.cabal @@ -65,6 +65,8 @@ Executable client Util.WaitFor View.App View.Header + View.Income.Add + View.Income.Form View.Income.Header View.Income.Income View.Income.Table diff --git a/client/src/Component.hs b/client/src/Component.hs index 4c51750..b715a83 100644 --- a/client/src/Component.hs +++ b/client/src/Component.hs @@ -4,7 +4,6 @@ import Component.Button as X import Component.Form as X import Component.Input as X import Component.Link as X -import Component.Modal as X import Component.Pages as X import Component.Select as X import Component.Table as X 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 diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs index 521c1a7..dc7e395 100644 --- a/client/src/View/Payment/Delete.hs +++ b/client/src/View/Payment/Delete.hs @@ -13,6 +13,7 @@ import qualified Common.Msg as Msg import Component (ButtonIn (..), ButtonOut (..)) import qualified Component as Component import qualified Component.Modal as Modal +import qualified Component.Modal as Modal import qualified Util.Ajax as Ajax import qualified Util.Either as EitherUtil import qualified Util.WaitFor as WaitFor diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs index 6ed3b0e..9db4c7c 100644 --- a/client/src/View/Payment/Header.hs +++ b/client/src/View/Payment/Header.hs @@ -111,16 +111,14 @@ payerAndAdd incomes payments users categories paymentCategories currency frequen R.dynText . R.ffor exceedingPayer $ \ep -> Format.price currency $ _exceedingPayer_amount ep - addPaymentClic <- _buttonOut_clic <$> (Component.button $ ButtonIn - { _buttonIn_class = R.constDyn "addPayment" - , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add - , _buttonIn_waiting = R.never - , _buttonIn_tabIndex = Nothing - , _buttonIn_submit = False - }) + addPayment <- _buttonOut_clic <$> + (Component.button $ + (Component.defaultButtonIn (R.text $ Msg.get Msg.Payment_Add)) + { _buttonIn_class = R.constDyn "addPayment" + }) Modal.view $ Modal.Input - { Modal._input_show = addPaymentClic + { Modal._input_show = addPayment , Modal._input_content = Add.view $ Add.Input { Add._input_categories = categories , Add._input_paymentCategories = paymentCategories diff --git a/common/common.cabal b/common/common.cabal index 64a3b3e..6c7c779 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -29,6 +29,7 @@ Library Exposed-modules: Common.Model + Common.Model.CreateIncomeForm Common.Model.CreatePaymentForm Common.Model.Email Common.Model.Payment @@ -40,6 +41,7 @@ Library Common.Util.Time Common.Util.Validation Common.Validation.Atomic + Common.Validation.Income Common.Validation.Payment Common.Validation.SignIn Common.View.Format @@ -50,10 +52,10 @@ Library Common.Message.Translation Common.Model.Category Common.Model.CreateCategory - Common.Model.CreateIncome Common.Model.Currency Common.Model.EditCategory Common.Model.EditIncome + Common.Model.EditIncomeForm Common.Model.EditPaymentForm Common.Model.Frequency Common.Model.Income diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 5b71a84..c9f500b 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -2,11 +2,12 @@ module Common.Model (module X) where import Common.Model.Category as X import Common.Model.CreateCategory as X -import Common.Model.CreateIncome as X +import Common.Model.CreateIncomeForm as X import Common.Model.CreatePaymentForm as X import Common.Model.Currency as X import Common.Model.EditCategory as X import Common.Model.EditIncome as X +import Common.Model.EditIncomeForm as X import Common.Model.EditPaymentForm as X import Common.Model.Email as X import Common.Model.Frequency as X diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs deleted file mode 100644 index 644a51c..0000000 --- a/common/src/Common/Model/CreateIncome.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Common.Model.CreateIncome - ( CreateIncome(..) - ) where - -import Data.Aeson (FromJSON) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) - -data CreateIncome = CreateIncome - { _createIncome_date :: Day - , _createIncome_amount :: Int - } deriving (Show, Generic) - -instance FromJSON CreateIncome diff --git a/common/src/Common/Model/CreateIncomeForm.hs b/common/src/Common/Model/CreateIncomeForm.hs new file mode 100644 index 0000000..e83bf0a --- /dev/null +++ b/common/src/Common/Model/CreateIncomeForm.hs @@ -0,0 +1,15 @@ +module Common.Model.CreateIncomeForm + ( CreateIncomeForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data CreateIncomeForm = CreateIncomeForm + { _createIncomeForm_amount :: Text + , _createIncomeForm_date :: Text + } deriving (Show, Generic) + +instance FromJSON CreateIncomeForm +instance ToJSON CreateIncomeForm diff --git a/common/src/Common/Model/EditIncomeForm.hs b/common/src/Common/Model/EditIncomeForm.hs new file mode 100644 index 0000000..ff975fc --- /dev/null +++ b/common/src/Common/Model/EditIncomeForm.hs @@ -0,0 +1,18 @@ +module Common.Model.EditIncomeForm + ( EditIncomeForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Income (IncomeId) + +data EditIncomeForm = EditIncomeForm + { _editIncomeForm_id :: IncomeId + , _editIncomeForm_amount :: Text + , _editIncomeForm_date :: Text + } deriving (Show, Generic) + +instance FromJSON EditIncomeForm +instance ToJSON EditIncomeForm diff --git a/common/src/Common/Validation/Income.hs b/common/src/Common/Validation/Income.hs new file mode 100644 index 0000000..7a58bab --- /dev/null +++ b/common/src/Common/Validation/Income.hs @@ -0,0 +1,17 @@ +module Common.Validation.Income + ( amount + , date + ) where + +import Data.Text (Text) +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as V + +import qualified Common.Validation.Atomic as Atomic + +amount :: Text -> Validation Text Int +amount input = V.bindValidation (Atomic.number input) Atomic.nonNullNumber + +date :: Text -> Validation Text Day +date = Atomic.day diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs index 1bb00ce..e3c447a 100644 --- a/common/src/Common/Validation/Payment.hs +++ b/common/src/Common/Validation/Payment.hs @@ -14,7 +14,6 @@ import Common.Model (CategoryId) import qualified Common.Msg as Msg import qualified Common.Validation.Atomic as Atomic - name :: Text -> Validation Text Text name = Atomic.nonEmpty diff --git a/server/server.cabal b/server/server.cabal index 426f521..022d496 100644 --- a/server/server.cabal +++ b/server/server.cabal @@ -94,7 +94,9 @@ Executable server Job.WeeklyReport Json LoginSession + Model.CreateIncome Model.CreatePayment + Model.EditIncome Model.EditPayment Model.IncomeResource Model.Mail @@ -113,6 +115,7 @@ Executable server Secure SendMail Util.Time + Validation.Income Validation.Payment View.Mail.SignIn View.Mail.WeeklyReport diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs index ed58ac8..e013849 100644 --- a/server/src/Controller/Income.hs +++ b/server/src/Controller/Income.hs @@ -5,21 +5,32 @@ module Controller.Income ) where import Control.Monad.IO.Class (liftIO) +import Data.Validation (Validation (Failure, Success)) import qualified Network.HTTP.Types.Status as Status import Web.Scotty hiding (delete) -import Common.Model (CreateIncome (..), EditIncome (..), - IncomeId, User (..)) +import Common.Model (CreateIncomeForm (..), + EditIncome (..), IncomeId, + User (..)) -import Json (jsonId) +import qualified Controller.Helper as ControllerHelper +import Model.CreateIncome (CreateIncome (..)) import qualified Model.Query as Query import qualified Persistence.Income as IncomePersistence import qualified Secure +import qualified Validation.Income as IncomeValidation -create :: CreateIncome -> ActionM () -create (CreateIncome date amount) = +create :: CreateIncomeForm -> ActionM () +create form = Secure.loggedAction (\user -> - (liftIO . Query.run $ IncomePersistence.create (_user_id user) date amount) >>= jsonId + (liftIO . Query.run $ do + case IncomeValidation.createIncome form of + Success (CreateIncome amount date) -> do + Right <$> (IncomePersistence.create (_user_id user) date amount) + + Failure validationError -> + return $ Left validationError + ) >>= ControllerHelper.jsonOrBadRequest ) edit :: EditIncome -> ActionM () diff --git a/server/src/Model/CreateIncome.hs b/server/src/Model/CreateIncome.hs new file mode 100644 index 0000000..82451d2 --- /dev/null +++ b/server/src/Model/CreateIncome.hs @@ -0,0 +1,10 @@ +module Model.CreateIncome + ( CreateIncome(..) + ) where + +import Data.Time.Calendar (Day) + +data CreateIncome = CreateIncome + { _createIncome_amount :: Int + , _createIncome_date :: Day + } deriving (Show) diff --git a/server/src/Model/EditIncome.hs b/server/src/Model/EditIncome.hs new file mode 100644 index 0000000..ac3d311 --- /dev/null +++ b/server/src/Model/EditIncome.hs @@ -0,0 +1,13 @@ +module Model.EditIncome + ( EditIncome(..) + ) where + +import Data.Time.Calendar (Day) + +import Common.Model (IncomeId) + +data EditIncome = EditIncome + { _editIncome_id :: IncomeId + , _editIncome_amount :: Int + , _editIncome_date :: Day + } deriving (Show) diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs index cee9892..a0c3bbf 100644 --- a/server/src/Persistence/Income.hs +++ b/server/src/Persistence/Income.hs @@ -36,15 +36,24 @@ list = SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL" ) -create :: UserId -> Day -> Int -> Query IncomeId -create incomeUserId incomeDate incomeAmount = +create :: UserId -> Day -> Int -> Query Income +create userId date amount = Query (\conn -> do - now <- getCurrentTime + createdAt <- getCurrentTime SQLite.execute conn "INSERT INTO income (user_id, date, amount, created_at) VALUES (?, ?, ?, ?)" - (incomeUserId, incomeDate, incomeAmount, now) - SQLite.lastInsertRowId conn + (userId, date, amount, createdAt) + incomeId <- SQLite.lastInsertRowId conn + return $ Income + { _income_id = incomeId + , _income_userId = userId + , _income_date = date + , _income_amount = amount + , _income_createdAt = createdAt + , _income_editedAt = Nothing + , _income_deletedAt = Nothing + } ) edit :: UserId -> IncomeId -> Day -> Int -> Query Bool diff --git a/server/src/Validation/Income.hs b/server/src/Validation/Income.hs new file mode 100644 index 0000000..5e034d1 --- /dev/null +++ b/server/src/Validation/Income.hs @@ -0,0 +1,27 @@ +module Validation.Income + ( createIncome + , editIncome + ) where + +import Data.Text (Text) +import Data.Validation (Validation) +import qualified Data.Validation as V + +import Common.Model (CreateIncomeForm (..), + EditIncomeForm (..)) +import qualified Common.Validation.Income as IncomeValidation +import Model.CreateIncome (CreateIncome (..)) +import Model.EditIncome (EditIncome (..)) + +createIncome :: CreateIncomeForm -> Validation Text CreateIncome +createIncome form = + CreateIncome + <$> IncomeValidation.amount (_createIncomeForm_amount form) + <*> IncomeValidation.date (_createIncomeForm_date form) + +editIncome :: EditIncomeForm -> Validation Text EditIncome +editIncome form = + EditIncome + <$> V.Success (_editIncomeForm_id form) + <*> IncomeValidation.amount (_editIncomeForm_amount form) + <*> IncomeValidation.date (_editIncomeForm_date form) -- cgit v1.2.3