aboutsummaryrefslogtreecommitdiff
path: root/server/src/Persistence/Category.hs
blob: 2afe5db04eb81348012ac804dd6866638da3a1dc (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
module Persistence.Category
  ( list
  , create
  , edit
  , delete
  ) where

import           Data.Maybe             (isJust, listToMaybe)
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)

list :: Query [Category]
list =
  Query (\conn ->
    map (\(Row c) -> c) <$>
      SQLite.query_ conn "SELECT * FROM category WHERE deleted_at IS NULL"
  )

create :: Text -> Text -> Query CategoryId
create categoryName categoryColor =
  Query (\conn -> do
    now <- getCurrentTime
    SQLite.execute
      conn
      "INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)"
      (categoryName, categoryColor, now)
    SQLite.lastInsertRowId conn
  )

edit :: CategoryId -> Text -> Text -> Query Bool
edit categoryId categoryName categoryColor =
  Query (\conn -> do
    mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$>
      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
    if 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) . listToMaybe <$>
      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
    if isJust mbCategory
      then do
        now <- getCurrentTime
        SQLite.execute
          conn
          "UPDATE category SET deleted_at = ? WHERE id = ?" (now, categoryId)
        return True
      else
        return False
  )