diff options
Diffstat (limited to 'server/src/Persistence/Payment.hs')
| -rw-r--r-- | server/src/Persistence/Payment.hs | 389 |
1 files changed, 0 insertions, 389 deletions
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs deleted file mode 100644 index 573d57f..0000000 --- a/server/src/Persistence/Payment.hs +++ /dev/null @@ -1,389 +0,0 @@ -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) |