1 files changed, 55 insertions, 0 deletions
diff --git a/src/server/Model/PaymentCategory.hs b/src/server/Model/PaymentCategory.hs
new file mode 100644
index 0000000..6df77e2
--- /dev/null
+++ b/src/server/Model/PaymentCategory.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Model.PaymentCategory
+  ( list
+  , listByCategory
+  , set
+  , edit
+  , delete
+  ) where
+
+import Data.Maybe (isJust)
+import Data.Text (Text)
+import Data.Time.Clock (getCurrentTime)
+import qualified Data.Text as T
+
+import Control.Monad.IO.Class (liftIO)
+
+import Database.Persist
+
+import Model.Database
+import qualified Model.Json.PaymentCategory as Json
+import qualified Utils.Text as T
+
+list :: Persist [Json.PaymentCategory]
+list = map getJsonPaymentCategory <$> selectList [] []
+
+listByCategory :: CategoryId -> Persist [Entity PaymentCategory]
+listByCategory category = selectList [ PaymentCategoryCategory ==. category ] []
+
+getJsonPaymentCategory :: Entity PaymentCategory -> Json.PaymentCategory
+getJsonPaymentCategory entity =
+  Json.PaymentCategory (paymentCategoryName pc) (paymentCategoryCategory pc)
+  where pc = entityVal entity
+
+set :: Text -> CategoryId -> Persist ()
+set name category = edit name name category
+
+edit :: Text -> Text -> CategoryId -> Persist ()
+edit oldName newName category = do
+  now <- liftIO getCurrentTime
+  mbPaymentCategory <- selectFirst [PaymentCategoryName ==. (formatPaymentName oldName)] []
+  if isJust mbPaymentCategory
+    then
+      updateWhere
+        [ PaymentCategoryName ==. (formatPaymentName oldName) ]
+        [ PaymentCategoryName =. (formatPaymentName newName)
+        , PaymentCategoryCategory =. category
+        , PaymentCategoryEditedAt =. Just now
+        ]
+    else do
+      _ <- insert $ PaymentCategory (formatPaymentName newName) category now Nothing
+      return ()
+
+formatPaymentName :: Text -> Text
+formatPaymentName = T.unaccent . T.toLower