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
|
module Persistence.Category
( count
, list
, listAll
, create
, edit
, delete
) where
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime)
import Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)))
import qualified Database.SQLite.Simple as SQLite
import Prelude hiding (id)
import Common.Model (Category (..), CategoryId)
import Model.Query (Query (Query))
newtype Row = Row Category
instance FromRow Row where
fromRow = Row <$> (Category <$>
SQLite.field <*>
SQLite.field <*>
SQLite.field <*>
SQLite.field <*>
SQLite.field <*>
SQLite.field)
data CountRow = CountRow Int
instance FromRow CountRow where
fromRow = CountRow <$> SQLite.field
count :: Query Int
count =
Query (\conn ->
(Maybe.fromMaybe 0 . fmap (\(CountRow n) -> n) . Maybe.listToMaybe) <$>
SQLite.query_ conn "SELECT COUNT(*) FROM category WHERE deleted_at IS NULL"
)
list :: Int -> Int -> Query [Category]
list page perPage =
Query (\conn ->
map (\(Row c) -> c) <$>
SQLite.queryNamed
conn
"SELECT * FROM category WHERE deleted_at IS NULL ORDER BY name LIMIT :limit OFFSET :offset"
[ ":limit" := perPage
, ":offset" := (page - 1) * perPage
]
)
listAll :: Query [Category]
listAll =
Query (\conn ->
map (\(Row c) -> c) <$>
SQLite.query_ conn "SELECT * FROM category WHERE deleted_at IS NULL"
)
create :: Text -> Text -> Query ()
create name color =
Query (\conn -> do
currentTime <- getCurrentTime
SQLite.executeNamed
conn
"INSERT INTO category (name, color, created_at) VALUES (:name, :color, :created_at)"
[ ":name" := name
, ":color" := color
, ":created_at" := currentTime
]
)
edit :: CategoryId -> Text -> Text -> Query Bool
edit id name color =
Query (\conn -> do
mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
(SQLite.queryNamed conn "SELECT * FROM category WHERE id = :id" [ ":id" := id ])
if Maybe.isJust mbCategory
then do
currentTime <- getCurrentTime
SQLite.executeNamed
conn
"UPDATE category SET edited_at = :editedAt, name = :name, color = :color WHERE id = :id"
[ ":editedAt" := currentTime
, ":name" := name
, ":color" := color
, ":id" := id
]
return True
else
return False
)
data BoolRow = BoolRow Int
instance FromRow BoolRow where
fromRow = BoolRow <$> SQLite.field
delete :: CategoryId -> Query Bool
delete id =
Query (\conn -> do
mbPayment <- (fmap (\(BoolRow b) -> b) . Maybe.listToMaybe) <$>
(SQLite.queryNamed
conn
"SELECT true FROM payment WHERE category = :id AND deleted_at IS NULL"
[ ":id" := id ])
if Maybe.isNothing mbPayment
then do
currentTime <- getCurrentTime
SQLite.executeNamed
conn
"UPDATE category SET deleted_at = :deletedAt WHERE id = :id AND deleted_at IS NULL"
[ ":deletedAt" := currentTime
, ":id" := id
]
return True
else
return False
)
|
