aboutsummaryrefslogtreecommitdiff
path: root/server/src/Controller/Category.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Controller/Category.hs')
-rw-r--r--server/src/Controller/Category.hs53
1 files changed, 53 insertions, 0 deletions
diff --git a/server/src/Controller/Category.hs b/server/src/Controller/Category.hs
new file mode 100644
index 0000000..d6ed2f2
--- /dev/null
+++ b/server/src/Controller/Category.hs
@@ -0,0 +1,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
+ )