path: root/server/src/Persistence/Payment.hs

module Persistence.Payment
  ( count
  , find
  , getRange
  , 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
        ]
  )

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)