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
|
module Persistence.Payment
( Payment(..)
, find
, listActive
, listPunctual
, listActiveMonthlyOrderedByName
, create
, createMany
, editOwn
, deleteOwn
) where
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
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.Query (Query (Query))
import Persistence.Frequency (FrequencyField (..))
newtype Row = Row Payment
instance FromRow Row where
fromRow = Row <$> (Payment <$>
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 (FrequencyField (_payment_frequency p))
, toField (_payment_createdAt p)
]
find :: PaymentId -> Query (Maybe Payment)
find paymentId =
Query (\conn -> do
fmap (\(Row p) -> p) . listToMaybe <$>
SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
)
listActive :: Query [Payment]
listActive =
Query (\conn -> do
map (\(Row p) -> p) <$>
SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
)
listPunctual :: Query [Payment]
listPunctual =
Query (\conn -> do
map (\(Row p) -> p) <$>
SQLite.query
conn
(SQLite.Query "SELECT * FROM payment WHERE frequency = ?")
(Only (FrequencyField Punctual))
)
listActiveMonthlyOrderedByName :: Query [Payment]
listActiveMonthlyOrderedByName =
Query (\conn -> do
map (\(Row p) -> p) <$>
SQLite.query
conn
(SQLite.Query $ T.intercalate " "
[ "SELECT *"
, "FROM payment"
, "WHERE deleted_at IS NULL AND frequency = ?"
, "ORDER BY name DESC"
])
(Only (FrequencyField 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, FrequencyField 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 (?, ?, ?, ?, ?, ?)"
])
(map InsertRow payments)
)
editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
editOwn userId paymentId paymentName paymentCost paymentDate paymentFrequency =
Query (\conn -> do
mbPayment <- fmap (\(Row p) -> p) . 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, FrequencyField 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 (Row 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
)
|