1 files changed, 66 insertions, 0 deletions
diff --git a/server/src/Persistence/PaymentCategory.hs b/server/src/Persistence/PaymentCategory.hs
new file mode 100644
index 0000000..1e377b1
--- /dev/null
+++ b/server/src/Persistence/PaymentCategory.hs
@@ -0,0 +1,66 @@
+module Persistence.PaymentCategory
+  ( list
+  , listByCategory
+  , save
+  ) where
+
+import           Data.Maybe             (isJust, listToMaybe)
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import           Data.Time.Clock        (getCurrentTime)
+import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
+import qualified Database.SQLite.Simple as SQLite
+
+import           Common.Model           (CategoryId, PaymentCategory (..))
+import qualified Common.Util.Text       as T
+
+import           Model.Query            (Query (Query))
+
+newtype Row = Row PaymentCategory
+
+instance FromRow Row where
+  fromRow = Row <$> (PaymentCategory <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field)
+
+list :: Query [PaymentCategory]
+list =
+  Query (\conn -> do
+    map (\(Row pc) -> pc) <$>
+      SQLite.query_ conn "SELECT * from payment_category"
+  )
+
+listByCategory :: CategoryId -> Query [PaymentCategory]
+listByCategory cat =
+  Query (\conn -> do
+    map (\(Row pc) -> pc) <$>
+      SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat)
+  )
+
+save :: Text -> CategoryId -> Query ()
+save newName categoryId =
+  Query (\conn -> do
+    now <- getCurrentTime
+    hasPaymentCategory <- isJust <$> listToMaybe <$>
+      (SQLite.query
+        conn
+        "SELECT * FROM payment_category WHERE name = ?"
+        (Only (formatPaymentName newName)) :: IO [Row])
+    if hasPaymentCategory
+      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