aboutsummaryrefslogtreecommitdiff
path: root/server/src/Persistence
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Persistence')
-rw-r--r--server/src/Persistence/Category.hs10
-rw-r--r--server/src/Persistence/Income.hs59
-rw-r--r--server/src/Persistence/Payment.hs214
-rw-r--r--server/src/Persistence/PaymentCategory.hs89
-rw-r--r--server/src/Persistence/User.hs4
5 files changed, 220 insertions, 156 deletions
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)
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 04:47:27 +0000