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

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)