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
|
module Persistence.PaymentCategory
( list
, listByCategory
, save
) where
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime)
import Database.SQLite.Simple (FromRow (fromRow), Only (Only))
import qualified Database.SQLite.Simple as SQLite
import Common.Model (CategoryId, PaymentCategory (..))
import qualified Common.Util.Text as T
import Model.Query (Query (Query))
newtype Row = Row PaymentCategory
instance FromRow Row where
fromRow = Row <$> (PaymentCategory <$>
SQLite.field <*>
SQLite.field <*>
SQLite.field <*>
SQLite.field <*>
SQLite.field)
list :: Query [PaymentCategory]
list =
Query (\conn -> do
map (\(Row pc) -> pc) <$>
SQLite.query_ conn "SELECT * from payment_category"
)
listByCategory :: CategoryId -> Query [PaymentCategory]
listByCategory cat =
Query (\conn -> do
map (\(Row pc) -> pc) <$>
SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat)
)
save :: Text -> CategoryId -> Query PaymentCategory
save newName categoryId =
Query (\conn -> do
now <- getCurrentTime
paymentCategory <- fmap (\(Row pc) -> pc) . Maybe.listToMaybe <$>
(SQLite.query
conn
"SELECT * FROM payment_category WHERE name = ?"
(Only formattedNewName))
case paymentCategory of
Just pc ->
do
SQLite.execute
conn
"UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?"
(categoryId, now, formattedNewName)
return $ PaymentCategory
(_paymentCategory_id pc)
formattedNewName
categoryId
(_paymentCategory_createdAt pc)
(Just now)
Nothing ->
do
SQLite.execute
conn
"INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)"
(formattedNewName, categoryId, now)
paymentCategoryId <- SQLite.lastInsertRowId conn
return $ PaymentCategory
paymentCategoryId
formattedNewName
categoryId
now
Nothing
)
where
formattedNewName = T.formatSearch newName
|
