src/server/Model/Category.hs


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

module Model.Category
  ( list
  , create
  , edit
  , delete
  ) where

import Data.Text (Text)
import Data.Maybe (isJust)
import Data.Time.Clock (getCurrentTime)

import Control.Monad.IO.Class (liftIO)

import Database.Persist hiding (delete)

import Model.Database
import qualified Model.Json.Category as Json

list :: Persist [Json.Category]
list = map getJsonCategory <$> selectList [ CategoryDeletedAt ==. Nothing ] []

getJsonCategory :: Entity Category -> Json.Category
getJsonCategory categoryEntity =
  Json.Category (entityKey categoryEntity) (categoryName category) (categoryColor category)
  where category = entityVal categoryEntity

create :: Text -> Text -> Persist CategoryId
create name color = do
  now <- liftIO getCurrentTime
  insert (Category name color now Nothing Nothing)

edit :: CategoryId -> Text -> Text -> Persist Bool
edit categoryId name color = do
  mbCategory <- get categoryId
  if isJust mbCategory
    then do
      now <- liftIO getCurrentTime
      update categoryId
        [ CategoryEditedAt =. Just now
        , CategoryName =. name
        , CategoryColor =. color
        ]
      return True
    else
      return False

delete :: CategoryId -> Persist Bool
delete categoryId = do
  mbCategory <- get categoryId
  if isJust mbCategory
    then do
      now <- liftIO getCurrentTime
      update categoryId [CategoryDeletedAt =. Just now]
      return True
    else
      return False