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
|
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), Only (Only))
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.query
conn
"SELECT * FROM category WHERE deleted_at IS NULL ORDER BY edited_at, created_at DESC LIMIT ? OFFSET ?"
(perPage, (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 categoryName categoryColor =
Query (\conn -> do
now <- getCurrentTime
SQLite.execute
conn
"INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)"
(categoryName, categoryColor, now)
)
edit :: CategoryId -> Text -> Text -> Query Bool
edit categoryId categoryName categoryColor =
Query (\conn -> do
mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
(SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
if Maybe.isJust mbCategory
then do
now <- getCurrentTime
SQLite.execute
conn
"UPDATE category SET edited_at = ?, name = ?, color = ? WHERE id = ?"
(now, categoryName, categoryColor, categoryId)
return True
else
return False
)
delete :: CategoryId -> Query Bool
delete categoryId =
Query (\conn -> do
mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
(SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
if Maybe.isJust mbCategory
then do
now <- getCurrentTime
SQLite.execute
conn
"UPDATE category SET deleted_at = ? WHERE id = ?" (now, categoryId)
return True
else
return False
)
|