server/src/Controller/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

{-# LANGUAGE OverloadedStrings #-}

module Controller.Category
  ( create
  , edit
  , delete
  ) where

import           Control.Monad.IO.Class    (liftIO)
import qualified Data.Text.Lazy            as TL
import           Network.HTTP.Types.Status (badRequest400, ok200)
import           Web.Scotty                hiding (delete)

import qualified Common.Message            as Message
import qualified Common.Message.Key        as Key
import           Common.Model              (CategoryId, CreateCategory (..),
                                            EditCategory (..))

import           Json                      (jsonId)
import qualified Model.Category            as Category
import qualified Model.PaymentCategory     as PaymentCategory
import qualified Model.Query               as Query
import qualified Secure

create :: CreateCategory -> ActionM ()
create (CreateCategory name color) =
  Secure.loggedAction (\_ ->
    (liftIO . Query.run $ Category.create name color) >>= jsonId
  )

edit :: EditCategory -> ActionM ()
edit (EditCategory categoryId name color) =
  Secure.loggedAction (\_ -> do
    updated <- liftIO . Query.run $ Category.edit categoryId name color
    if updated
      then status ok200
      else status badRequest400
  )

delete :: CategoryId -> ActionM ()
delete categoryId =
  Secure.loggedAction (\_ -> do
    deleted <- liftIO . Query.run $ do
      paymentCategories <- PaymentCategory.listByCategory categoryId
      if null paymentCategories
        then Category.delete categoryId
        else return False
    if deleted
      then
        status ok200
      else do
        status badRequest400
        text . TL.fromStrict $ Message.get Key.Category_NotDeleted
  )