From 9dbb4e6f7c2f0edc1126626e2ff498144c6b9947 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Nov 2019 11:28:42 +0100 Subject: Show income header --- client/src/View/Income/Header.hs | 35 ++++++++------------- client/src/View/Income/Income.hs | 29 +++++++++++------- client/src/View/Income/Reducer.hs | 8 ++--- common/common.cabal | 4 ++- common/src/Common/Model.hs | 3 +- common/src/Common/Model/IncomeHeader.hs | 18 +++++++++++ common/src/Common/Model/IncomePage.hs | 18 +++++++++++ common/src/Common/Model/IncomesAndCount.hs | 16 ---------- server/src/Controller/Income.hs | 49 +++++++++++++++++++++--------- server/src/Job/WeeklyReport.hs | 2 +- server/src/Main.hs | 7 ++--- server/src/Persistence/Income.hs | 23 ++++++++------ 12 files changed, 125 insertions(+), 87 deletions(-) create mode 100644 common/src/Common/Model/IncomeHeader.hs create mode 100644 common/src/Common/Model/IncomePage.hs delete mode 100644 common/src/Common/Model/IncomesAndCount.hs diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs index 8e82525..8451ee4 100644 --- a/client/src/View/Income/Header.hs +++ b/client/src/View/Income/Header.hs @@ -5,13 +5,15 @@ module View.Income.Header ) 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 (..), User (..)) +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 @@ -23,9 +25,9 @@ import qualified View.Income.Form as Form import View.Income.Init (Init (..)) data In t = In - { _in_init :: Init + { _in_users :: [User] + , _in_header :: IncomeHeader , _in_currency :: Currency - , _in_incomes :: Dynamic t [Income] } data Out t = Out @@ -38,11 +40,11 @@ view input = currentTime <- liftIO Clock.getCurrentTime - R.dyn . R.ffor useIncomesFrom $ \case - (Nothing, _) -> + case _incomeHeader_since $ _in_header input of + Nothing -> R.blank - (Just since, incomes) -> + Just since -> R.el "div" $ do R.el "h1" $ do @@ -50,15 +52,13 @@ view input = R.text $ Msg.get (Msg.Income_CumulativeSince (Format.longDay day)) R.el "ul" $ - flip mapM_ (_init_users init) $ \user -> + flip mapM_ (M.toList . _incomeHeader_byUser $ _in_header input) $ \(userId, amount) -> R.el "li" $ - R.text $ do - let userIncomes = filter ((==) (_user_id user) . _income_userId) incomes + R.text $ T.intercalate " " - [ _user_name user + [ Maybe.fromMaybe "" . fmap _user_name $ CM.findUser userId (_in_users input) , "−" - , Format.price (_in_currency input) $ - CM.cumulativeIncomesSince currentTime since userIncomes + , Format.price (_in_currency input) amount ] R.divClass "titleButton" $ do @@ -78,14 +78,3 @@ view input = return $ Out { _out_add = addIncome } - - where - init = _in_init input - - useIncomesFrom = R.ffor (_in_incomes input) $ \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 d31775a..d82ab4d 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -11,15 +11,15 @@ import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Currency, Income (..), - IncomesAndCount (..), User, UserId) +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 View.Income.Header as Header +import qualified View.Income.Header as Header import View.Income.Init (Init (..)) import qualified View.Income.Reducer as Reducer import qualified View.Income.Table as Table @@ -36,22 +36,29 @@ view input = do incomes <- Reducer.reducer $ Reducer.In { Reducer._in_newPage = newPage , Reducer._in_currentPage = currentPage - , Reducer._in_addIncome = addIncome + , Reducer._in_addIncome = R.leftmost [headerAddIncome, tableAddIncome] , Reducer._in_editIncome = editIncome , Reducer._in_deleteIncome = deleteIncome } - let eventFromResult :: forall a. ((Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a) + 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 - newPage <- eventFromResult $ Pages._out_newPage . snd + newPage <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c) currentPage <- R.holdDyn 1 newPage - addIncome <- eventFromResult $ Table._out_add . fst - editIncome <- eventFromResult $ Table._out_edit . fst - deleteIncome <- eventFromResult $ Table._out_delete . fst + 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 <- R.dyn . R.ffor ((,) <$> incomes <*> currentPage) $ \(is, p) -> - flip Loadable.view is $ \(IncomesAndCount incomes count) -> do + flip Loadable.view is $ \(IncomePage 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 @@ -65,6 +72,6 @@ view input = do , Pages._in_page = p } - return (table, pages) + return (header, table, pages) return () diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs index 5b346cb..092d9b3 100644 --- a/client/src/View/Income/Reducer.hs +++ b/client/src/View/Income/Reducer.hs @@ -9,7 +9,7 @@ import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (IncomesAndCount) +import Common.Model (IncomePage) import Loadable (Loadable (..)) import qualified Loadable as Loadable @@ -28,9 +28,9 @@ data In t a b c = In data Action = LoadPage Int - | GetResult (Either Text IncomesAndCount) + | GetResult (Either Text IncomePage) -reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomesAndCount)) +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 @@ -60,7 +60,7 @@ reducer input = do where pageUrl p = - "api/v2/incomes?page=" + "api/incomes?page=" <> (T.pack . show $ p) <> "&perPage=" <> (T.pack . show $ perPage) diff --git a/common/common.cabal b/common/common.cabal index 9f3f65b..651673f 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -24,6 +24,7 @@ Library Build-depends: aeson , base >= 4.11 && < 5 + , containers , text , time , validation @@ -60,7 +61,8 @@ Library Common.Model.EditPaymentForm Common.Model.Frequency Common.Model.Income - Common.Model.IncomesAndCount + Common.Model.IncomeHeader + Common.Model.IncomePage Common.Model.Init Common.Model.InitResult Common.Model.Payer diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 3a5a627..313f26b 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -12,7 +12,8 @@ import Common.Model.EditPaymentForm as X import Common.Model.Email as X import Common.Model.Frequency as X import Common.Model.Income as X -import Common.Model.IncomesAndCount as X +import Common.Model.IncomeHeader as X +import Common.Model.IncomePage as X import Common.Model.Init as X import Common.Model.InitResult as X import Common.Model.Payer as X diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs new file mode 100644 index 0000000..a1defdf --- /dev/null +++ b/common/src/Common/Model/IncomeHeader.hs @@ -0,0 +1,18 @@ +module Common.Model.IncomeHeader + ( IncomeHeader(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import Data.Time.Clock (UTCTime) +import GHC.Generics (Generic) + +import Common.Model.User (UserId) + +data IncomeHeader = IncomeHeader + { _incomeHeader_since :: Maybe UTCTime + , _incomeHeader_byUser :: Map UserId Int + } deriving (Show, Generic) + +instance FromJSON IncomeHeader +instance ToJSON IncomeHeader diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs new file mode 100644 index 0000000..c3f478e --- /dev/null +++ b/common/src/Common/Model/IncomePage.hs @@ -0,0 +1,18 @@ +module Common.Model.IncomePage + ( IncomePage(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Income (Income) +import Common.Model.IncomeHeader (IncomeHeader) + +data IncomePage = IncomePage + { _incomePage_header :: IncomeHeader + , _incomePage_incomes :: [Income] + , _incomePage_totalCount :: Int + } deriving (Show, Generic) + +instance FromJSON IncomePage +instance ToJSON IncomePage diff --git a/common/src/Common/Model/IncomesAndCount.hs b/common/src/Common/Model/IncomesAndCount.hs deleted file mode 100644 index 4365180..0000000 --- a/common/src/Common/Model/IncomesAndCount.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Common.Model.IncomesAndCount - ( IncomesAndCount(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) - -import Common.Model.Income (Income) - -data IncomesAndCount = IncomesAndCount - { _incomesAndCount_incomes :: [Income] - , _incomesAndCount_count :: Int - } deriving (Show, Generic) - -instance FromJSON IncomesAndCount -instance ToJSON IncomesAndCount diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs index 3272cbf..d8d3d89 100644 --- a/server/src/Controller/Income.hs +++ b/server/src/Controller/Income.hs @@ -1,42 +1,61 @@ module Controller.Income ( list - , listv2 , create , edit , delete ) where import Control.Monad.IO.Class (liftIO) +import qualified Data.Map as M +import qualified Data.Time.Clock as Clock import Data.Validation (Validation (Failure, Success)) import qualified Network.HTTP.Types.Status as Status import Web.Scotty hiding (delete) import Common.Model (CreateIncomeForm (..), - EditIncomeForm (..), IncomeId, - IncomesAndCount (..), User (..)) + EditIncomeForm (..), Income (..), + IncomeHeader (..), IncomeId, + IncomePage (..), User (..)) +import qualified Common.Model as CM import qualified Controller.Helper as ControllerHelper import Model.CreateIncome (CreateIncome (..)) import Model.EditIncome (EditIncome (..)) import qualified Model.Query as Query import qualified Persistence.Income as IncomePersistence +import qualified Persistence.Payment as PaymentPersistence +import qualified Persistence.User as UserPersistence import qualified Secure import qualified Validation.Income as IncomeValidation -list :: ActionM () -list = - Secure.loggedAction (\_ -> - (liftIO . Query.run $ IncomePersistence.list) >>= json - ) - -listv2 :: Int -> Int -> ActionM () -listv2 page perPage = - Secure.loggedAction (\_ -> +list :: Int -> Int -> ActionM () +list page perPage = + Secure.loggedAction (\_ -> do + currentTime <- liftIO Clock.getCurrentTime (liftIO . Query.run $ do count <- IncomePersistence.count - incomes <- IncomePersistence.listv2 page perPage - return $ IncomesAndCount incomes count - ) >>= json + + users <- UserPersistence.list + allPayments <- PaymentPersistence.listPunctual -- TODO: get first payment defined for all + allIncomes <- IncomePersistence.listAll + + let since = + CM.useIncomesFrom (map _user_id users) allIncomes allPayments + + let byUser = + case since of + Just s -> + M.fromList . flip map users $ \user -> + ( _user_id user + , CM.cumulativeIncomesSince currentTime s $ + filter ((==) (_user_id user) . _income_userId) allIncomes + ) + + Nothing -> + M.empty + + incomes <- IncomePersistence.list page perPage + return $ IncomePage (IncomeHeader since byUser) incomes count) >>= json ) create :: CreateIncomeForm -> ActionM () diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs index 203c4e8..1a478dc 100644 --- a/server/src/Job/WeeklyReport.hs +++ b/server/src/Job/WeeklyReport.hs @@ -19,7 +19,7 @@ weeklyReport conf mbLastExecution = do Nothing -> return () Just lastExecution -> do (payments, incomes, users) <- Query.run $ - (,,) <$> PaymentPersistence.listPunctual <*> IncomePersistence.list <*> UserPersistence.list + (,,) <$> PaymentPersistence.listPunctual <*> IncomePersistence.listAll <*> UserPersistence.list _ <- SendMail.sendMail conf (WeeklyReport.mail conf users payments incomes lastExecution now) return () return now diff --git a/server/src/Main.hs b/server/src/Main.hs index 00e8d1c..40b53b6 100644 --- a/server/src/Main.hs +++ b/server/src/Main.hs @@ -54,13 +54,10 @@ main = do paymentId <- S.param "id" Payment.delete paymentId - S.get "/api/v2/incomes" $ do + S.get "/api/incomes" $ do page <- S.param "page" perPage <- S.param "perPage" - Income.listv2 page perPage - - S.get "/api/incomes" $ - Income.list + Income.list page perPage S.post "/api/income" $ S.jsonData >>= Income.create diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs index de55a18..4ae3228 100644 --- a/server/src/Persistence/Income.hs +++ b/server/src/Persistence/Income.hs @@ -1,7 +1,7 @@ module Persistence.Income ( count , list - , listv2 + , listAll , create , edit , delete @@ -43,15 +43,8 @@ count = SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL" ) -list :: Query [Income] -list = - Query (\conn -> - map (\(Row i) -> i) <$> - SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL" - ) - -listv2 :: Int -> Int -> Query [Income] -listv2 page perPage = +list :: Int -> Int -> Query [Income] +list page perPage = Query (\conn -> map (\(Row i) -> i) <$> SQLite.query @@ -60,6 +53,16 @@ listv2 page perPage = (perPage, (page - 1) * perPage) ) +listAll :: Query [Income] +listAll = + Query (\conn -> + map (\(Row i) -> i) <$> + SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL" + ) + +-- firstIncomeByUser +-- SELECT user_id, MIN(date) FROM income WHERE deleted_at IS NULL GROUP BY user_id; + create :: UserId -> Day -> Int -> Query Income create userId date amount = Query (\conn -> do -- cgit v1.2.3