aboutsummaryrefslogtreecommitdiff
path: root/server/src/Model/Payment.hs
blob: c1b109fc69418ea78b8bfa859917a2bd19383e64 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Model.Payment
  ( Payment(..)
  , find
  , list
  , listMonthly
  , create
  , createMany
  , editOwn
  , deleteOwn
  , modifiedDuring
  ) where

import           Data.Maybe                     (listToMaybe)
import           Data.Text                      (Text)
import qualified Data.Text                      as T
import           Data.Time                      (UTCTime)
import           Data.Time.Calendar             (Day)
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)

import           Common.Model                   (Frequency (..), Payment (..),
                                                 PaymentId, UserId)

import           Model.Frequency                ()
import           Model.Query                    (Query (Query))
import           Resource                       (Resource, resourceCreatedAt,
                                                 resourceDeletedAt,
                                                 resourceEditedAt)

instance Resource Payment where
  resourceCreatedAt = _payment_createdAt
  resourceEditedAt = _payment_editedAt
  resourceDeletedAt = _payment_deletedAt

instance FromRow Payment where
  fromRow = Payment <$>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field <*>
    SQLite.field

instance ToRow Payment where
  toRow p =
    [ toField (_payment_user p)
    , toField (_payment_name p)
    , toField (_payment_cost p)
    , toField (_payment_date p)
    , toField (_payment_frequency p)
    , toField (_payment_createdAt p)
    ]

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
      (SQLite.Query $ T.intercalate " "
        [ "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 userId paymentName paymentCost paymentDate paymentFrequency =
  Query (\conn -> do
    now <- getCurrentTime
    SQLite.execute
      conn
      (SQLite.Query $ T.intercalate " "
        [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)"
        , "VALUES (?, ?, ?, ?, ?, ?)"
        ])
      (userId, paymentName, paymentCost, paymentDate, paymentFrequency, now)
    SQLite.lastInsertRowId conn
  )

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

editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
editOwn userId 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 _payment_user payment == userId
          then do
            now <- getCurrentTime
            SQLite.execute
              conn
              (SQLite.Query $ T.intercalate " "
                [ "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 userId paymentId =
  Query (\conn -> do
    mbPayment <- listToMaybe <$>
      SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
    case mbPayment of
      Just payment ->
        if _payment_user payment == userId
          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]
modifiedDuring start end =
  Query (\conn ->
    SQLite.query
      conn
      (SQLite.Query $ T.intercalate " "
        [ "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)
  )