aboutsummaryrefslogtreecommitdiff
path: root/server/src/Controller/Category.hs
blob: e536caaf5851c327ed66908b95d709817fe13ac6 (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
module Controller.Category
  ( list
  , 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           Common.Model                (CategoryId, CreateCategory (..),
                                              EditCategory (..))
import qualified Common.Msg                  as Msg

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

list :: ActionM ()
list =
  Secure.loggedAction (\_ ->
    (liftIO . Query.run $ CategoryPersistence.list) >>= json
  )

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

edit :: EditCategory -> ActionM ()
edit (EditCategory categoryId name color) =
  Secure.loggedAction (\_ -> do
    updated <- liftIO . Query.run $ CategoryPersistence.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 <- PaymentCategoryPersistence.listByCategory categoryId
      if null paymentCategories
        then CategoryPersistence.delete categoryId
        else return False
    if deleted
      then
        status ok200
      else do
        status badRequest400
        text . TL.fromStrict $ Msg.get Msg.Category_NotDeleted
  )