aboutsummaryrefslogtreecommitdiff
path: root/server/src/Persistence/Payment.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Persistence/Payment.hs')
-rw-r--r--server/src/Persistence/Payment.hs214
1 files changed, 161 insertions, 53 deletions
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-03 09:59:40 +0000