From cfca18262c1ff48dcb683ddab7d03cf8e55573ff Mon Sep 17 00:00:00 2001
From: Joris
Date: Fri, 24 Mar 2017 09:21:04 +0000
Subject: Features/categories

---
 src/server/Controller/Category.hs | 54 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)
 create mode 100644 src/server/Controller/Category.hs

(limited to 'src/server/Controller/Category.hs')

diff --git a/src/server/Controller/Category.hs b/src/server/Controller/Category.hs
new file mode 100644
index 0000000..19109a3
--- /dev/null
+++ b/src/server/Controller/Category.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Controller.Category
+  ( create
+  , edit
+  , delete
+  ) where
+
+import Control.Monad.IO.Class (liftIO)
+
+import Data.Text (Text)
+import Network.HTTP.Types.Status (ok200, badRequest400)
+import qualified Data.Text.Lazy as TL
+import Web.Scotty hiding (delete)
+
+import Json (jsonId)
+import Model.Database
+import qualified Model.Category as Category
+import qualified Model.Json.CreateCategory as Json
+import qualified Model.Json.EditCategory as Json
+import qualified Model.Message.Key as Key
+import qualified Model.PaymentCategory as PaymentCategory
+import qualified Secure
+
+create :: Json.CreateCategory -> ActionM ()
+create (Json.CreateCategory name color) =
+  Secure.loggedAction (\_ ->
+    (liftIO . runDb $ Category.create name color) >>= jsonId
+  )
+
+edit :: Json.EditCategory -> ActionM ()
+edit (Json.EditCategory categoryId name color) =
+  Secure.loggedAction (\_ -> do
+    updated <- liftIO . runDb $ Category.edit categoryId name color
+    if updated
+      then status ok200
+      else status badRequest400
+  )
+
+delete :: Text -> ActionM ()
+delete categoryId =
+  Secure.loggedAction (\_ -> do
+    deleted <- liftIO . runDb $ do
+      paymentCategories <- PaymentCategory.listByCategory (textToKey categoryId)
+      if null paymentCategories
+        then Category.delete (textToKey categoryId)
+        else return False
+    if deleted
+      then
+        status ok200
+      else do
+        status badRequest400
+        text . TL.pack . show $ Key.CategoryNotDeleted
+  )
-- 
cgit v1.2.3