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)