From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Nov 2019 18:08:28 +0100 Subject: Optimize and refactor payments --- server/src/Persistence/Category.hs | 10 +- server/src/Persistence/Income.hs | 59 +++++++- server/src/Persistence/Payment.hs | 214 ++++++++++++++++++++++-------- server/src/Persistence/PaymentCategory.hs | 89 ------------- server/src/Persistence/User.hs | 4 +- 5 files changed, 220 insertions(+), 156 deletions(-) delete mode 100644 server/src/Persistence/PaymentCategory.hs (limited to 'server/src/Persistence') diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs index 2afe5db..00cf0a5 100644 --- a/server/src/Persistence/Category.hs +++ b/server/src/Persistence/Category.hs @@ -5,7 +5,7 @@ module Persistence.Category , delete ) where -import Data.Maybe (isJust, listToMaybe) +import qualified Data.Maybe as Maybe import Data.Text (Text) import Data.Time.Clock (getCurrentTime) import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) @@ -48,9 +48,9 @@ create categoryName categoryColor = edit :: CategoryId -> Text -> Text -> Query Bool edit categoryId categoryName categoryColor = Query (\conn -> do - mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$> + mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$> (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId)) - if isJust mbCategory + if Maybe.isJust mbCategory then do now <- getCurrentTime SQLite.execute @@ -65,9 +65,9 @@ edit categoryId categoryName categoryColor = delete :: CategoryId -> Query Bool delete categoryId = Query (\conn -> do - mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$> + mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$> (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId)) - if isJust mbCategory + if Maybe.isJust mbCategory then do now <- getCurrentTime SQLite.execute diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs index cb2ef10..ba7ad19 100644 --- a/server/src/Persistence/Income.hs +++ b/server/src/Persistence/Income.hs @@ -2,17 +2,22 @@ module Persistence.Income ( count , list , listAll + , listModifiedSince , create , edit , delete + , definedForAll ) where -import Data.Maybe (listToMaybe) +import qualified Data.List as L +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 qualified Database.SQLite.Simple as SQLite -import Prelude hiding (id) +import Prelude hiding (id, until) import Common.Model (Income (..), IncomeId, PaymentId, UserId) @@ -31,15 +36,15 @@ instance FromRow Row where SQLite.field <*> SQLite.field) -data Count = Count Int +data CountRow = CountRow Int -instance FromRow Count where - fromRow = Count <$> SQLite.field +instance FromRow CountRow where + fromRow = CountRow <$> SQLite.field count :: Query Int count = Query (\conn -> - (\[Count n] -> n) <$> + (Maybe.fromMaybe 0 . fmap (\(CountRow n) -> n) . Maybe.listToMaybe) <$> SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL" ) @@ -60,6 +65,23 @@ listAll = SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL" ) +listModifiedSince :: UTCTime -> Query [Income] +listModifiedSince since = + Query (\conn -> + map (\(Row i) -> i) <$> + SQLite.query + conn + (SQLite.Query . T.intercalate " " $ + [ "SELECT *" + , "FROM income" + , "WHERE" + , "created_at >= ?" + , "OR edited_at >= ?" + , "OR deleted_at >= ?" + ]) + (Only since) + ) + create :: UserId -> Day -> Int -> Query Income create userId date amount = Query (\conn -> do @@ -83,7 +105,7 @@ create userId date amount = edit :: UserId -> IncomeId -> Day -> Int -> Query (Maybe Income) edit userId incomeId incomeDate incomeAmount = Query (\conn -> do - mbIncome <- fmap (\(Row i) -> i) . listToMaybe <$> + mbIncome <- fmap (\(Row i) -> i) . Maybe.listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId) case mbIncome of Just income -> @@ -114,3 +136,26 @@ delete userId paymentId = "UPDATE income SET deleted_at = datetime('now') WHERE id = ? AND user_id = ?" (paymentId, userId) ) + +data UserDayRow = UserDayRow (UserId, Day) + +instance FromRow UserDayRow where + fromRow = do + user <- SQLite.field + day <- SQLite.field + return $ UserDayRow (user, day) + +definedForAll :: [UserId] -> Query (Maybe Day) +definedForAll users = + Query (\conn -> + (fromRows . fmap (\(UserDayRow (user, day)) -> (user, day))) <$> + SQLite.query_ + conn + "SELECT user_id, MIN(date) FROM income WHERE deleted_at IS NULL GROUP BY user_id;" + ) + where + fromRows rows = + if L.sort users == L.sort (map fst rows) then + Maybe.listToMaybe . L.sort . map snd $ rows + else + Nothing diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs index 7835c98..f75925d 100644 --- a/server/src/Persistence/Payment.hs +++ b/server/src/Persistence/Payment.hs @@ -1,33 +1,57 @@ module Persistence.Payment ( count , find - , firstPunctualDay - , listActive + , getRange , listActivePage - , listPunctual + , listModifiedSince , listActiveMonthlyOrderedByName , create , createMany , edit , delete + , searchCategory + , repartition + , getPreAndPostPaymentRepartition ) where -import Data.Maybe (listToMaybe) +import Data.Map (Map) +import qualified Data.Map as M +import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day) +import qualified Data.Time.Calendar as Calendar +import Data.Time.Clock (UTCTime) import Data.Time.Clock (getCurrentTime) import Database.SQLite.Simple (FromRow (fromRow), Only (Only), ToRow) import qualified Database.SQLite.Simple as SQLite import Database.SQLite.Simple.ToField (ToField (toField)) -import Prelude hiding (id) +import Prelude hiding (id, until) -import Common.Model (Frequency (..), Payment (..), - PaymentId, UserId) +import Common.Model (CategoryId, Frequency (..), + Payment (..), PaymentId, + User (..), UserId) import Model.Query (Query (Query)) import Persistence.Frequency (FrequencyField (..)) +import qualified Persistence.Income as IncomePersistence + + + +fields :: Text +fields = T.intercalate "," $ + [ "id" + , "user_id" + , "name" + , "cost" + , "date" + , "category" + , "frequency" + , "created_at" + , "edited_at" + , "deleted_at" + ] newtype Row = Row Payment @@ -38,6 +62,7 @@ instance FromRow Row where SQLite.field <*> SQLite.field <*> SQLite.field <*> + SQLite.field <*> (fmap (\(FrequencyField f) -> f) $ SQLite.field) <*> SQLite.field <*> SQLite.field <*> @@ -51,6 +76,7 @@ instance ToRow InsertRow where , toField (_payment_name p) , toField (_payment_cost p) , toField (_payment_date p) + , toField (_payment_category p) , toField (FrequencyField (_payment_frequency p)) , toField (_payment_createdAt p) ] @@ -60,73 +86,94 @@ data Count = Count Int instance FromRow Count where fromRow = Count <$> SQLite.field -count :: Query Int -count = +count :: Frequency -> Text -> Query Int +count frequency search = Query (\conn -> (\[Count n] -> n) <$> - SQLite.query_ conn "SELECT COUNT(*) FROM payment WHERE deleted_at IS NULL" + SQLite.query + conn + (SQLite.Query $ T.intercalate " " + [ "SELECT COUNT(*)" + , "FROM payment" + , "WHERE" + , "deleted_at IS NULL" + , "AND frequency = ?" + , "AND name LIKE ?" + ]) + (FrequencyField frequency, "%" <> search <> "%") ) find :: PaymentId -> Query (Maybe Payment) find paymentId = Query (\conn -> do - fmap (\(Row p) -> p) . listToMaybe <$> - SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId) + fmap (\(Row p) -> p) . Maybe.listToMaybe <$> + SQLite.query + conn + (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ?") + (Only paymentId) ) -data DayRow = DayRow Day +data RangeRow = RangeRow (Day, Day) -instance FromRow DayRow where - fromRow = DayRow <$> SQLite.field +instance FromRow RangeRow where + fromRow = (\f t -> RangeRow (f, t)) <$> SQLite.field <*> SQLite.field -firstPunctualDay :: Query (Maybe Day) -firstPunctualDay = +getRange :: Query (Maybe (Day, Day)) +getRange = Query (\conn -> do - fmap (\(DayRow d) -> d) . listToMaybe <$> + fmap (\(RangeRow (f, t)) -> (f, t)) . Maybe.listToMaybe <$> SQLite.query conn - "SELECT date FROM payment WHERE frequency = ? AND deleted_at IS NULL ORDER BY date LIMIT 1" + (SQLite.Query $ T.intercalate " " + [ "SELECT MIN(date), MAX(date)" + , "FROM payment" + , "WHERE" + , "frequency = ?" + , "AND deleted_at IS NULL" + ]) (Only (FrequencyField Punctual)) ) -listActive :: Frequency -> Query [Payment] -listActive frequency = - Query (\conn -> do - map (\(Row p) -> p) <$> - SQLite.query - conn - "SELECT * FROM payment WHERE deleted_at IS NULL AND frequency = ?" - (Only (FrequencyField frequency)) - ) - -listActivePage :: Int -> Int -> Query [Payment] -listActivePage page perPage = +listActivePage :: Frequency -> Int -> Int -> Text -> Query [Payment] +listActivePage frequency page perPage search = Query (\conn -> map (\(Row p) -> p) <$> SQLite.query conn (SQLite.Query $ T.intercalate " " - [ "SELECT *" + [ "SELECT" + , fields , "FROM payment" - , "WHERE deleted_at IS NULL AND frequency = ?" + , "WHERE" + , "deleted_at IS NULL" + , "AND frequency = ?" + , "AND name LIKE ?" , "ORDER BY date DESC" , "LIMIT ?" , "OFFSET ?" ] ) - (FrequencyField Punctual, perPage, (page - 1) * perPage) + (FrequencyField frequency, "%" <> search <> "%", perPage, (page - 1) * perPage) ) -listPunctual :: Query [Payment] -listPunctual = - Query (\conn -> do - map (\(Row p) -> p) <$> +listModifiedSince :: UTCTime -> Query [Payment] +listModifiedSince since = + Query (\conn -> + map (\(Row i) -> i) <$> SQLite.query conn - (SQLite.Query "SELECT * FROM payment WHERE frequency = ?") - (Only (FrequencyField Punctual)) + (SQLite.Query . T.intercalate " " $ + [ "SELECT *" + , "FROM payment" + , "WHERE" + , "created_at >= ?" + , "OR edited_at >= ?" + , "OR deleted_at >= ?" + ]) + (Only since) ) + listActiveMonthlyOrderedByName :: Query [Payment] listActiveMonthlyOrderedByName = Query (\conn -> do @@ -134,7 +181,8 @@ listActiveMonthlyOrderedByName = SQLite.query conn (SQLite.Query $ T.intercalate " " - [ "SELECT *" + [ "SELECT" + , fields , "FROM payment" , "WHERE deleted_at IS NULL AND frequency = ?" , "ORDER BY name DESC" @@ -142,17 +190,17 @@ listActiveMonthlyOrderedByName = (Only (FrequencyField Monthly)) ) -create :: UserId -> Text -> Int -> Day -> Frequency -> Query Payment -create userId name cost date frequency = +create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query Payment +create userId name cost date category frequency = Query (\conn -> do time <- getCurrentTime SQLite.execute conn (SQLite.Query $ T.intercalate " " - [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)" - , "VALUES (?, ?, ?, ?, ?, ?)" + [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)" + , "VALUES (?, ?, ?, ?, ?, ?, ?)" ]) - (userId, name, cost, date, FrequencyField frequency, time) + (userId, name, cost, date, category, FrequencyField frequency, time) paymentId <- SQLite.lastInsertRowId conn return $ Payment { _payment_id = paymentId @@ -160,6 +208,7 @@ create userId name cost date frequency = , _payment_name = name , _payment_cost = cost , _payment_date = date + , _payment_category = category , _payment_frequency = frequency , _payment_createdAt = time , _payment_editedAt = Nothing @@ -173,19 +222,19 @@ createMany payments = SQLite.executeMany conn (SQLite.Query $ T.intercalate "" - [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)" - , "VALUES (?, ?, ?, ?, ?, ?)" + [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)" + , "VALUES (?, ?, ?, ?, ?, ?, ?)" ]) (map InsertRow payments) ) -edit :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query (Maybe (Payment, Payment)) -edit userId paymentId name cost date frequency = +edit :: UserId -> PaymentId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query (Maybe Payment) +edit userId paymentId name cost date category frequency = Query (\conn -> do - mbPayment <- fmap (\(Row p) -> p) . listToMaybe <$> + mbPayment <- fmap (\(Row p) -> p) . Maybe.listToMaybe <$> SQLite.query conn - "SELECT * FROM payment WHERE id = ? and user_id = ?" + (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ? and user_id = ?") (paymentId, userId) case mbPayment of Just payment -> do @@ -200,6 +249,7 @@ edit userId paymentId name cost date frequency = , " name = ?," , " cost = ?," , " date = ?," + , " category = ?," , " frequency = ?" , "WHERE" , " id = ?" @@ -209,16 +259,18 @@ edit userId paymentId name cost date frequency = , name , cost , date + , category , FrequencyField frequency , paymentId , userId ) - return . Just . (,) payment $ Payment + return . Just $ Payment { _payment_id = paymentId , _payment_user = userId , _payment_name = name , _payment_cost = cost , _payment_date = date + , _payment_category = category , _payment_frequency = frequency , _payment_createdAt = _payment_createdAt payment , _payment_editedAt = Just now @@ -236,3 +288,59 @@ delete userId paymentId = "UPDATE payment SET deleted_at = datetime('now') WHERE id = ? AND user_id = ?" (paymentId, userId) ) + +data CategoryIdRow = CategoryIdRow CategoryId + +instance FromRow CategoryIdRow where + fromRow = CategoryIdRow <$> SQLite.field + +searchCategory :: Text -> Query (Maybe CategoryId) +searchCategory paymentName = + Query (\conn -> + fmap (\(CategoryIdRow d) -> d) . Maybe.listToMaybe <$> + SQLite.query + conn + "SELECT category FROM payment WHERE name LIKE ? LIMIT 1" + (Only $ "%" <> paymentName <> "%") + ) + +data UserCostRow = UserCostRow (UserId, Int) + +instance FromRow UserCostRow where + fromRow = do + user <- SQLite.field + cost <- SQLite.field + return $ UserCostRow (user, cost) + +repartition :: Frequency -> Text -> Day -> Day -> Query (Map UserId Int) +repartition frequency search from to = + Query (\conn -> + M.fromList . fmap (\(UserCostRow r) -> r) <$> SQLite.query + conn + (SQLite.Query . T.intercalate " " $ + [ "SELECT user_id, SUM(cost)" + , "FROM payment" + , "WHERE" + , "deleted_at IS NULL" + , "AND frequency = ?" + , "AND name LIKE ?" + , "AND date >= ?" + , "AND date < ?" + , "GROUP BY user_id" + ]) + (FrequencyField frequency, "%" <> search <> "%", from, to) + ) + +getPreAndPostPaymentRepartition :: Maybe (Day, Day) -> [User] -> Query (Map UserId Int, Map UserId Int) +getPreAndPostPaymentRepartition paymentRange users = do + case paymentRange of + Just (from, to) -> do + incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users) + (,) + <$> (repartition Punctual "" from (Maybe.fromMaybe (Calendar.addDays 1 to) incomeDefinedForAll)) + <*> (case incomeDefinedForAll of + Just d -> repartition Punctual "" d (Calendar.addDays 1 to) + Nothing -> return M.empty) + + Nothing -> + return (M.empty, M.empty) diff --git a/server/src/Persistence/PaymentCategory.hs b/server/src/Persistence/PaymentCategory.hs deleted file mode 100644 index 46be7f5..0000000 --- a/server/src/Persistence/PaymentCategory.hs +++ /dev/null @@ -1,89 +0,0 @@ -module Persistence.PaymentCategory - ( list - , listByCategory - , save - , deleteIfUnused - ) where - -import qualified Data.Maybe as Maybe -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time.Clock (getCurrentTime) -import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) -import qualified Database.SQLite.Simple as SQLite - -import Common.Model (CategoryId, PaymentCategory (..)) - -import Model.Query (Query (Query)) - -newtype Row = Row PaymentCategory - -instance FromRow Row where - fromRow = Row <$> (PaymentCategory <$> - SQLite.field <*> - SQLite.field <*> - SQLite.field <*> - SQLite.field <*> - SQLite.field) - -list :: Query [PaymentCategory] -list = - Query (\conn -> do - map (\(Row pc) -> pc) <$> - SQLite.query_ conn "SELECT * from payment_category" - ) - -listByCategory :: CategoryId -> Query [PaymentCategory] -listByCategory cat = - Query (\conn -> do - map (\(Row pc) -> pc) <$> - SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat) - ) - -save :: Text -> CategoryId -> Query PaymentCategory -save newName categoryId = - Query (\conn -> do - now <- getCurrentTime - paymentCategory <- fmap (\(Row pc) -> pc) . Maybe.listToMaybe <$> - (SQLite.query - conn - "SELECT * FROM payment_category WHERE name = ?" - (Only formattedNewName)) - case paymentCategory of - Just pc -> - do - SQLite.execute - conn - "UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?" - (categoryId, now, formattedNewName) - return $ PaymentCategory - (_paymentCategory_id pc) - formattedNewName - categoryId - (_paymentCategory_createdAt pc) - (Just now) - Nothing -> - do - SQLite.execute - conn - "INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)" - (formattedNewName, categoryId, now) - paymentCategoryId <- SQLite.lastInsertRowId conn - return $ PaymentCategory - paymentCategoryId - formattedNewName - categoryId - now - Nothing - ) - where - formattedNewName = T.toLower newName - -deleteIfUnused :: Text -> Query () -deleteIfUnused name = - Query (\conn -> - SQLite.execute - conn - "DELETE FROM payment_category WHERE name = lower(?) AND name NOT IN (SELECT DISTINCT lower(name) FROM payment WHERE lower(name) = lower(?) AND deleted_at IS NULL)" - (name, name) - ) >> return () diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs index 4ec2dcf..3c3a2b1 100644 --- a/server/src/Persistence/User.hs +++ b/server/src/Persistence/User.hs @@ -3,7 +3,7 @@ module Persistence.User , get ) where -import Data.Maybe (listToMaybe) +import qualified Data.Maybe as Maybe import Data.Text (Text) import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) import qualified Database.SQLite.Simple as SQLite @@ -32,6 +32,6 @@ list = get :: Text -> Query (Maybe User) get userEmail = Query (\conn -> do - fmap (\(Row u) -> u) . listToMaybe <$> + fmap (\(Row u) -> u) . Maybe.listToMaybe <$> SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail) ) -- cgit v1.2.3