module Persistence.Payment ( count , find , getRange , listActivePage , listModifiedSince , listActiveMonthlyOrderedByName , create , createMany , edit , delete , searchCategory , repartition , getPreAndPostPaymentRepartition ) 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), Only (Only), 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 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 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.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) . Maybe.listToMaybe <$> SQLite.query conn (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ?") (Only 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.query conn (SQLite.Query $ T.intercalate " " [ "SELECT MIN(date), MAX(date)" , "FROM payment" , "WHERE" , "frequency = ?" , "AND deleted_at IS NULL" ]) (Only (FrequencyField Punctual)) ) 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" , fields , "FROM payment" , "WHERE" , "deleted_at IS NULL" , "AND frequency = ?" , "AND name LIKE ?" , "ORDER BY date DESC" , "LIMIT ?" , "OFFSET ?" ] ) (FrequencyField frequency, "%" <> search <> "%", perPage, (page - 1) * perPage) ) listModifiedSince :: UTCTime -> Query [Payment] listModifiedSince since = Query (\conn -> map (\(Row i) -> i) <$> SQLite.query conn (SQLite.Query . T.intercalate " " $ [ "SELECT " <> fields , "FROM payment" , "WHERE" , "created_at >= ?" , "OR edited_at >= ?" , "OR deleted_at >= ?" ]) (since, since, since) ) listActiveMonthlyOrderedByName :: Query [Payment] listActiveMonthlyOrderedByName = Query (\conn -> do map (\(Row p) -> p) <$> SQLite.query conn (SQLite.Query $ T.intercalate " " [ "SELECT" , fields , "FROM payment" , "WHERE deleted_at IS NULL AND frequency = ?" , "ORDER BY name DESC" ]) (Only (FrequencyField Monthly)) ) create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query () create userId name cost date category frequency = Query (\conn -> do currentTime <- getCurrentTime SQLite.execute conn (SQLite.Query $ T.intercalate " " [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)" , "VALUES (?, ?, ?, ?, ?, ?, ?)" ]) (userId, name, cost, date, category, FrequencyField frequency, 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.query conn (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ? and user_id = ?") (paymentId, userId) if Maybe.isJust payment then do currentTime <- getCurrentTime SQLite.execute conn (SQLite.Query $ T.intercalate " " [ "UPDATE" , " payment" , "SET" , " edited_at = ?," , " name = ?," , " cost = ?," , " date = ?," , " category = ?," , " frequency = ?" , "WHERE" , " id = ?" , " AND user_id = ?" ]) ( currentTime , name , cost , date , category , FrequencyField frequency , paymentId , userId ) return True else return False ) delete :: UserId -> PaymentId -> Query () delete userId paymentId = Query (\conn -> SQLite.execute conn "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 (SQLite.Query . T.intercalate " " $ [ "SELECT category" , "FROM payment" , "WHERE deleted_at is NULL AND name LIKE ?" , "ORDER BY edited_at, created_at" , "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)