Payment.hs 4.39 KB
Newer Older
Joris's avatar
Joris committed
1 2
{-# LANGUAGE OverloadedStrings #-}

3
module Model.Payment
Joris's avatar
Joris committed
4 5 6
  ( PaymentId
  , Payment(..)
  , find
Joris's avatar
Joris committed
7
  , list
8 9
  , listMonthly
  , create
Joris's avatar
Joris committed
10
  , createMany
11
  , editOwn
12
  , deleteOwn
13
  , modifiedDuring
14 15
  ) where

Joris's avatar
Joris committed
16 17
import Data.Int (Int64)
import Data.Maybe (listToMaybe)
18
import Data.Text (Text)
19
import Data.Time (UTCTime)
20
import Data.Time.Calendar (Day)
Joris's avatar
Joris committed
21 22 23 24 25
import Data.Time.Clock (getCurrentTime)
import Database.SQLite.Simple (Only(Only), FromRow(fromRow), ToRow)
import Database.SQLite.Simple.ToField (ToField(toField))
import Prelude hiding (id)
import qualified Database.SQLite.Simple as SQLite
26

Joris's avatar
Joris committed
27 28 29 30
import Model.Frequency
import Model.Query (Query(Query))
import Model.User (UserId)
import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
31

Joris's avatar
Joris committed
32
type PaymentId = Int64
33

Joris's avatar
Joris committed
34 35 36 37 38 39 40 41 42 43 44
data Payment = Payment
  { id :: PaymentId
  , userId :: UserId
  , name :: Text
  , cost :: Int
  , date :: Day
  , frequency :: Frequency
  , createdAt :: UTCTime
  , editedAt :: Maybe UTCTime
  , deletedAt :: Maybe UTCTime
  } deriving Show
45

Joris's avatar
Joris committed
46 47 48 49
instance Resource Payment where
  resourceCreatedAt = createdAt
  resourceEditedAt = editedAt
  resourceDeletedAt = deletedAt
Joris's avatar
Joris committed
50

Joris's avatar
Joris committed
51 52 53 54 55 56 57 58 59 60 61
instance FromRow Payment where
  fromRow = Payment <$>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field
62

Joris's avatar
Joris committed
63 64 65 66 67 68 69 70
instance ToRow Payment where
  toRow p =
    [ toField (userId p)
    , toField (name p)
    , toField (cost p)
    , toField (date p)
    , toField (frequency p)
    , toField (createdAt p)
71
    ]
Joris's avatar
Joris committed
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156

find :: PaymentId -> Query (Maybe Payment)
find paymentId =
  Query (\conn -> listToMaybe <$>
    SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
  )

list :: Query [Payment]
list =
  Query (\conn ->
    SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
  )

listMonthly :: Query [Payment]
listMonthly =
  Query (\conn ->
    SQLite.query
      conn
      "SELECT * FROM payment WHERE deleted_at IS NULL AND frequency = ? ORDER BY name DESC"
      (Only Monthly)
  )

create :: UserId -> Text -> Int -> Day -> Frequency -> Query PaymentId
create paymentUserId paymentName paymentCost paymentDate paymentFrequency =
  Query (\conn -> do
    now <- getCurrentTime
    SQLite.execute
      conn
      "INSERT INTO payment (user_id, name, cost, date, frequency, created_at) VALUES (?, ?, ?, ?, ?, ?)"
      (paymentUserId, paymentName, paymentCost, paymentDate, paymentFrequency, now)
    SQLite.lastInsertRowId conn
  )

createMany :: [Payment] -> Query ()
createMany payments =
  Query (\conn ->
    SQLite.executeMany
      conn
      "INSERT INTO payment (user_id, name, cost, date, frequency, created_at) VALUES (?, ?, ?, ?, ?, ?)"
      payments
  )

editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
editOwn paymentUserId paymentId paymentName paymentCost paymentDate paymentFrequency =
  Query (\conn -> do
    mbPayment <- listToMaybe <$>
      SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
    case mbPayment of
      Just payment ->
        if userId payment == paymentUserId
          then do
            now <- getCurrentTime
            SQLite.execute
              conn
              "UPDATE payment SET edited_at = ?, name = ?, cost = ?, date = ?, frequency = ? WHERE id = ?"
              (now, paymentName, paymentCost, paymentDate, paymentFrequency, paymentId)
            return True
          else
            return False
      Nothing ->
        return False
  )

deleteOwn :: UserId -> PaymentId -> Query Bool
deleteOwn paymentUserId paymentId =
  Query (\conn -> do
    mbPayment <- listToMaybe <$>
      SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
    case mbPayment of
      Just payment ->
        if userId payment == paymentUserId
          then do
            now <- getCurrentTime
            SQLite.execute
              conn
              "UPDATE payment SET deleted_at = ? WHERE id = ?"
              (now, paymentId)
            return True
          else
            return False
      Nothing ->
        return False
  )

modifiedDuring :: UTCTime -> UTCTime -> Query [Payment]
157
modifiedDuring start end =
Joris's avatar
Joris committed
158 159 160 161 162 163
  Query (\conn ->
    SQLite.query
      conn
      "SELECT * FROM payment WHERE (created_at >= ? AND created_at <= ?) OR (edited_at >= ? AND edited_at <= ?) OR (deleted_at >= ? AND deleted_at <= ?)"
      (start, end, start, end, start, end)
  )