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

{-# LANGUAGE OverloadedStrings #-}

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

import Control.Monad.IO.Class (liftIO)
import Network.HTTP.Types.Status (ok200, badRequest400)
import qualified Data.Text.Lazy as TL
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
  )