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 +++++++++++++++++++++++++++++++++++++++
 src/server/Controller/Index.hs    | 10 ++++----
 src/server/Controller/Payment.hs  | 21 ++++++++++++---
 src/server/Controller/User.hs     | 11 ++------
 4 files changed, 78 insertions(+), 18 deletions(-)
 create mode 100644 src/server/Controller/Category.hs

(limited to 'src/server/Controller')

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
+  )
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
index abb3b17..96d0a49 100644
--- a/src/server/Controller/Index.hs
+++ b/src/server/Controller/Index.hs
@@ -1,18 +1,18 @@
 module Controller.Index
-  ( getIndex
+  ( get
   , signOut
   ) where
 
 import Control.Monad.IO.Class (liftIO)
 
-import Web.Scotty
+import Web.Scotty hiding (get)
 
 import Network.HTTP.Types.Status (ok200)
 
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime, diffUTCTime)
 
-import Database.Persist hiding (Key)
+import Database.Persist hiding (Key, get)
 
 import Conf (Conf(..))
 import qualified LoginSession
@@ -28,8 +28,8 @@ import Model.Init (getInit)
 
 import View.Page (page)
 
-getIndex :: Conf -> Maybe Text -> ActionM ()
-getIndex conf mbToken = do
+get :: Conf -> Maybe Text -> ActionM ()
+get conf mbToken = do
   initResult <- case mbToken of
     Just token -> do
       userOrError <- validateSignIn conf token
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 9155a78..e3f1082 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -23,6 +23,7 @@ import Json (jsonId)
 
 import Model.Database
 import qualified Model.Payment as Payment
+import qualified Model.PaymentCategory as PaymentCategory
 import qualified Model.Json.CreatePayment as Json
 import qualified Model.Json.EditPayment as Json
 
@@ -33,15 +34,27 @@ list =
   )
 
 create :: Json.CreatePayment -> ActionM ()
-create (Json.CreatePayment name cost date frequency) =
+create (Json.CreatePayment name cost date category frequency) =
   Secure.loggedAction (\user ->
-    (liftIO . runDb $ Payment.create (entityKey user) name cost date frequency) >>= jsonId
+    (liftIO . runDb $ do
+      PaymentCategory.set name category
+      Payment.create (entityKey user) name cost date frequency
+    ) >>= jsonId
   )
 
 editOwn :: Json.EditPayment -> ActionM ()
-editOwn (Json.EditPayment paymentId name cost date frequency) =
+editOwn (Json.EditPayment paymentId name cost date category frequency) =
   Secure.loggedAction (\user -> do
-    updated <- liftIO . runDb $ Payment.editOwn (entityKey user) paymentId name cost date frequency
+    updated <- liftIO . runDb $ do
+      mbPayment <- fmap entityVal <$> Payment.find paymentId
+      case mbPayment of
+        Just payment -> do
+          edited <- Payment.editOwn (entityKey user) paymentId name cost date frequency
+          if edited
+            then PaymentCategory.edit (paymentName payment) name category >> return True
+            else return edited
+        _ ->
+          return False
     if updated
       then status ok200
       else status badRequest400
diff --git a/src/server/Controller/User.hs b/src/server/Controller/User.hs
index 1baab18..d8604ac 100644
--- a/src/server/Controller/User.hs
+++ b/src/server/Controller/User.hs
@@ -2,7 +2,6 @@
 
 module Controller.User
   ( getUsers
-  , whoAmI
   ) where
 
 import Web.Scotty
@@ -12,16 +11,10 @@ import Control.Monad.IO.Class (liftIO)
 import qualified Secure
 
 import Model.Database
-import qualified Model.User as U
+import qualified Model.User as User
 
 getUsers :: ActionM ()
 getUsers =
   Secure.loggedAction (\_ ->
-    (liftIO $ map U.getJsonUser <$> runDb U.getUsers) >>= json
-  )
-
-whoAmI :: ActionM ()
-whoAmI =
-  Secure.loggedAction (\user ->
-    json (U.getJsonUser user)
+    (liftIO $ map User.getJsonUser <$> runDb User.list) >>= json
   )
-- 
cgit v1.2.3