From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 24 Nov 2019 16:19:53 +0100 Subject: Compute cumulative income with a DB query --- server/src/Persistence/Income.hs | 58 +++++++++++++++++++++++++++++++-------- server/src/Persistence/Payment.hs | 12 ++++++-- 2 files changed, 56 insertions(+), 14 deletions(-) (limited to 'server/src/Persistence') diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs index ba7ad19..e689505 100644 --- a/server/src/Persistence/Income.hs +++ b/server/src/Persistence/Income.hs @@ -1,21 +1,24 @@ module Persistence.Income ( count , list - , listAll , listModifiedSince , create , edit , delete , definedForAll + , getCumulativeIncome ) where import qualified Data.List as L +import Data.Map (Map) +import qualified Data.Map as M import qualified Data.Maybe as Maybe import qualified Data.Text as T import Data.Time.Calendar (Day) import Data.Time.Clock (UTCTime) import Data.Time.Clock (getCurrentTime) -import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) +import Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)), + Only (Only)) import qualified Database.SQLite.Simple as SQLite import Prelude hiding (id, until) @@ -58,13 +61,6 @@ list 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" - ) - listModifiedSince :: UTCTime -> Query [Income] listModifiedSince since = Query (\conn -> @@ -79,7 +75,7 @@ listModifiedSince since = , "OR edited_at >= ?" , "OR deleted_at >= ?" ]) - (Only since) + (since, since, since) ) create :: UserId -> Day -> Int -> Query Income @@ -156,6 +152,46 @@ definedForAll users = where fromRows rows = if L.sort users == L.sort (map fst rows) then - Maybe.listToMaybe . L.sort . map snd $ rows + Maybe.listToMaybe . reverse . L.sort . map snd $ rows else Nothing + +getCumulativeIncome :: Day -> Day -> Query (Map UserId Int) +getCumulativeIncome start end = + Query (\conn -> M.fromList <$> SQLite.queryNamed conn (SQLite.Query query) parameters) + where + query = + T.intercalate "\n" $ + [ "SELECT user_id, CAST(ROUND(SUM(count)) AS INTEGER) FROM (" + , " SELECT" + , " I1.user_id," + , " ((JULIANDAY(MIN(I2.date)) - JULIANDAY(I1.date)) * I1.amount * 12 / 365) AS count" + , " FROM (" <> (selectBoundedIncomes ">" ":start") <> ") AS I1" + , " INNER JOIN (" <> (selectBoundedIncomes "<" ":end") <> ") AS I2" + , " ON I2.date > I1.date AND I2.user_id == I1.user_id" + , " GROUP BY I1.date, I1.user_id" + , ") GROUP BY user_id" + ] + + selectBoundedIncomes op param = + T.intercalate "\n" $ + [ " SELECT user_id, date, amount FROM (" + , " SELECT" + , " i.user_id, " <> param <> " AS date, i.amount" + , " FROM" + , " (SELECT id, MAX(date) AS max_date" + , " FROM income" + , " WHERE date <= " <> param <> " AND deleted_at IS NULL" + , " GROUP BY user_id) AS m" + , " INNER JOIN income AS i" + , " ON i.id = m.id AND i.date = m.max_date" + , " ) UNION" + , " SELECT user_id, date, amount" + , " FROM income" + , " WHERE date " <> op <> " " <> param <> " AND deleted_at IS NULL" + ] + + parameters = + [ ":start" := start + , ":end" := end + ] diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs index f75925d..953f0ae 100644 --- a/server/src/Persistence/Payment.hs +++ b/server/src/Persistence/Payment.hs @@ -163,14 +163,14 @@ listModifiedSince since = SQLite.query conn (SQLite.Query . T.intercalate " " $ - [ "SELECT *" + [ "SELECT " <> fields , "FROM payment" , "WHERE" , "created_at >= ?" , "OR edited_at >= ?" , "OR deleted_at >= ?" ]) - (Only since) + (since, since, since) ) @@ -300,7 +300,13 @@ searchCategory paymentName = fmap (\(CategoryIdRow d) -> d) . Maybe.listToMaybe <$> SQLite.query conn - "SELECT category FROM payment WHERE name LIKE ? LIMIT 1" + (SQLite.Query . T.intercalate " " $ + [ "SELECT category" + , "FROM payment" + , "WHERE deleted_at is NULL AND name LIKE ?" + , "ORDER BY edited_at, created_at" + , "LIMIT 1" + ]) (Only $ "%" <> paymentName <> "%") ) -- cgit v1.2.3