diff options
Diffstat (limited to 'server/src/Persistence/Payment.hs')
| -rw-r--r-- | server/src/Persistence/Payment.hs | 389 |
1 files changed, 389 insertions, 0 deletions
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs new file mode 100644 index 0000000..573d57f --- /dev/null +++ b/server/src/Persistence/Payment.hs @@ -0,0 +1,389 @@ +module Persistence.Payment + ( count + , find + , getRange + , listAllPunctual + , listActivePage + , listModifiedPunctualSince + , listActiveMonthlyOrderedByName + , create + , createMany + , edit + , delete + , searchCategory + , repartition + , getPreAndPostPaymentRepartition + , usedCategories + ) where + +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), + NamedParam ((:=)), ToRow) +import qualified Database.SQLite.Simple as SQLite +import Database.SQLite.Simple.ToField (ToField (toField)) +import Prelude hiding (id, until) + +import Common.Model (CategoryId, Frequency (..), + Payment (..), PaymentId, + User (..), UserId) +import qualified Common.Util.Text as TextUtil + +import Model.Query (Query (Query)) +import Persistence.Frequency (FrequencyField (..)) +import qualified Persistence.Income as IncomePersistence +import qualified Persistence.Util as PersistenceUtil + + +fields :: Text +fields = T.intercalate "," $ + [ "id" + , "user_id" + , "name" + , "cost" + , "date" + , "category" + , "frequency" + , "created_at" + , "edited_at" + , "deleted_at" + ] + +newtype Row = Row Payment + +instance FromRow Row where + fromRow = Row <$> (Payment <$> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + (fmap (\(FrequencyField f) -> f) $ SQLite.field) <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field) + +newtype InsertRow = InsertRow Payment + +instance ToRow InsertRow where + toRow (InsertRow p) = + [ toField (_payment_user p) + , 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) + ] + +data Count = Count Int + +instance FromRow Count where + fromRow = Count <$> SQLite.field + +count :: Frequency -> Text -> Query Int +count frequency search = + Query (\conn -> + (\[Count n] -> n) <$> + SQLite.queryNamed + conn + (SQLite.Query $ T.intercalate " " + [ "SELECT COUNT(*)" + , "FROM payment" + , "WHERE" + , "deleted_at IS NULL" + , "AND frequency = :frequency" + , "AND (" <> PersistenceUtil.formatKeyForSearch "name" <> " LIKE :search OR cost LIKE :search)" + ]) + [ ":frequency" := FrequencyField frequency + , ":search" := "%" <> TextUtil.formatSearch search <> "%" + ] + ) + +find :: PaymentId -> Query (Maybe Payment) +find paymentId = + Query (\conn -> do + fmap (\(Row p) -> p) . Maybe.listToMaybe <$> + SQLite.queryNamed + conn + (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = :id") + [ "id" := paymentId + ] + ) + +data RangeRow = RangeRow (Day, Day) + +instance FromRow RangeRow where + fromRow = (\f t -> RangeRow (f, t)) <$> SQLite.field <*> SQLite.field + +getRange :: Query (Maybe (Day, Day)) +getRange = + Query (\conn -> do + fmap (\(RangeRow (f, t)) -> (f, t)) . Maybe.listToMaybe <$> + SQLite.queryNamed + conn + (SQLite.Query $ T.intercalate " " + [ "SELECT MIN(date), MAX(date)" + , "FROM payment" + , "WHERE" + , "frequency = :frequency" + , "AND deleted_at IS NULL" + ]) + [ ":frequency" := FrequencyField Punctual + ] + ) + +listAllPunctual :: Query [Payment] +listAllPunctual = + Query (\conn -> + map (\(Row p) -> p) <$> + SQLite.queryNamed + conn + (SQLite.Query $ T.intercalate " " + [ "SELECT" + , fields + , "FROM payment" + , "WHERE deleted_at IS NULL AND frequency = :frequency" + , "ORDER BY date" + ]) + [ ":frequency" := FrequencyField Punctual + ] + ) + + +listActivePage :: Frequency -> Int -> Int -> Text -> Query [Payment] +listActivePage frequency page perPage search = + Query (\conn -> + map (\(Row p) -> p) <$> + SQLite.queryNamed + conn + (SQLite.Query $ T.intercalate " " + [ "SELECT" + , fields + , "FROM payment" + , "WHERE" + , "deleted_at IS NULL" + , "AND frequency = :frequency" + , "AND (" <> PersistenceUtil.formatKeyForSearch "name" <> " LIKE :search OR cost LIKE :search)" + , "ORDER BY date DESC" + , "LIMIT :limit" + , "OFFSET :offset" + ] + ) + [ ":frequency" := FrequencyField frequency + , ":search" := "%" <> TextUtil.formatSearch search <> "%" + , ":limit" := perPage + , ":offset" := (page - 1) * perPage + ] + ) + +listModifiedPunctualSince :: UTCTime -> Query [Payment] +listModifiedPunctualSince since = + Query (\conn -> + map (\(Row i) -> i) <$> + SQLite.queryNamed + conn + (SQLite.Query . T.intercalate " " $ + [ "SELECT " <> fields + , "FROM payment" + , "WHERE" + , "frequency = :frequency" + , "AND (created_at >= :since OR edited_at >= :since OR deleted_at >= :since)" + ]) + [ ":frequency" := FrequencyField Punctual + , ":since" := since + ] + ) + + +listActiveMonthlyOrderedByName :: Query [Payment] +listActiveMonthlyOrderedByName = + Query (\conn -> do + map (\(Row p) -> p) <$> + SQLite.queryNamed + conn + (SQLite.Query $ T.intercalate " " + [ "SELECT" + , fields + , "FROM payment" + , "WHERE deleted_at IS NULL AND frequency = :frequency" + , "ORDER BY name DESC" + ]) + [ ":frequency" := FrequencyField Monthly + ] + ) + +create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query () +create userId name cost date category frequency = + Query (\conn -> do + currentTime <- getCurrentTime + SQLite.executeNamed + conn + (SQLite.Query $ T.intercalate " " + [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)" + , "VALUES (:userId, :name, :cost, :date, :category, :frequency, :currentTime)" + ]) + [ ":userId" := userId + , ":name" := name + , ":cost" := cost + , ":date" := date + , ":category" := category + , ":frequency" := FrequencyField frequency + , ":currentTime" := currentTime + ] + ) + +createMany :: [Payment] -> Query () +createMany payments = + Query (\conn -> + SQLite.executeMany + conn + (SQLite.Query $ T.intercalate "" + [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)" + , "VALUES (?, ?, ?, ?, ?, ?, ?)" + ]) + (map InsertRow payments) + ) + +edit :: UserId -> PaymentId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query Bool +edit userId paymentId name cost date category frequency = + Query (\conn -> do + payment <- fmap (\(Row p) -> p) . Maybe.listToMaybe <$> + SQLite.queryNamed + conn + (SQLite.Query $ + "SELECT " <> fields <> " FROM payment WHERE id = :paymentId and user_id = :userId") + [ ":paymentId" := paymentId + , ":userId" := userId + ] + if Maybe.isJust payment then + do + currentTime <- getCurrentTime + SQLite.executeNamed + conn + (SQLite.Query $ T.intercalate " " + [ "UPDATE" + , " payment" + , "SET" + , " edited_at = :editedAt," + , " name = :name," + , " cost = :cost," + , " date = :date," + , " category = :category," + , " frequency = :frequency" + , "WHERE" + , " id = :id" + , " AND user_id = :userId" + ]) + [ ":editedAt" := currentTime + , ":name" := name + , ":cost" := cost + , ":date" := date + , ":category" := category + , ":frequency" := FrequencyField frequency + , ":id" := paymentId + , ":userId" := userId + ] + return True + else + return False + ) + +delete :: UserId -> PaymentId -> Query () +delete userId paymentId = + Query (\conn -> + SQLite.executeNamed + conn + "UPDATE payment SET deleted_at = datetime('now') WHERE id = :id AND user_id = :userId" + [ ":id" := paymentId + , ":userId" := 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.queryNamed + conn + (SQLite.Query . T.intercalate " " $ + [ "SELECT category" + , "FROM payment" + , "WHERE deleted_at is NULL AND name LIKE :name" + , "ORDER BY edited_at, created_at" + , "LIMIT 1" + ]) + [ ":name" := "%" <> paymentName <> "%" + ] + ) + +usedCategories :: Query [CategoryId] +usedCategories = + Query (\conn -> do + map (\(CategoryIdRow p) -> p) <$> + SQLite.query_ + conn + (SQLite.Query $ T.intercalate " " + [ "SELECT DISTINCT category" + , "FROM payment" + , "WHERE deleted_at IS NULL" + ]) + ) + +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.queryNamed + conn + (SQLite.Query . T.intercalate " " $ + [ "SELECT user_id, SUM(cost)" + , "FROM payment" + , "WHERE" + , "deleted_at IS NULL" + , "AND frequency = :frequency" + , "AND (" <> PersistenceUtil.formatKeyForSearch "name" <> " LIKE :search OR cost LIKE :search)" + , "AND date >= :from" + , "AND date < :to" + , "GROUP BY user_id" + ]) + [ ":frequency" := FrequencyField frequency + , ":search" := "%" <> TextUtil.formatSearch search <> "%" + , ":from" := from + , ":to" := 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) |