1 files changed, 62 insertions, 0 deletions
diff --git a/server/src/Model/PaymentCategory.hs b/server/src/Model/PaymentCategory.hs
new file mode 100644
index 0000000..6e1d304
--- /dev/null
+++ b/server/src/Model/PaymentCategory.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Model.PaymentCategory
+  ( list
+  , listByCategory
+  , save
+  ) where
+
+import Data.Maybe (isJust, listToMaybe)
+import Data.Text (Text)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
+import qualified Data.Text as T
+import qualified Database.SQLite.Simple as SQLite
+
+import Common.Model (CategoryId, PaymentCategory(..))
+import qualified Common.Util.Text as T
+
+import Model.Query (Query(Query))
+
+instance FromRow PaymentCategory where
+  fromRow = PaymentCategory <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
+
+list :: Query [PaymentCategory]
+list = Query (\conn -> SQLite.query_ conn "SELECT * from payment_category")
+
+listByCategory :: CategoryId -> Query [PaymentCategory]
+listByCategory cat =
+  Query (\conn ->
+    SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat)
+  )
+
+save :: Text -> CategoryId -> Query ()
+save newName categoryId =
+  Query (\conn -> do
+    now <- getCurrentTime
+    mbPaymentCategory <- listToMaybe <$>
+      (SQLite.query
+        conn
+        "SELECT * FROM payment_category WHERE name = ?"
+        (Only (formatPaymentName newName)) :: IO [PaymentCategory])
+    if isJust mbPaymentCategory
+      then
+        SQLite.execute
+          conn
+          "UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?"
+          (categoryId, now, formatPaymentName newName)
+      else do
+        SQLite.execute
+          conn
+          "INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)"
+          (formatPaymentName newName, categoryId, now)
+  )
+  where
+    formatPaymentName :: Text -> Text
+    formatPaymentName = T.unaccent . T.toLower