1 files changed, 58 insertions, 35 deletions
diff --git a/src/server/Model/PaymentCategory.hs b/src/server/Model/PaymentCategory.hs
index 3b0b858..668fb01 100644
--- a/src/server/Model/PaymentCategory.hs
+++ b/src/server/Model/PaymentCategory.hs
@@ -1,48 +1,71 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Model.PaymentCategory
-  ( list
+  ( PaymentCategoryId
+  , PaymentCategory(..)
+  , list
   , listByCategory
   , save
   ) where
 
-import Control.Monad.IO.Class (liftIO)
-import Data.Maybe (isJust)
-
+import Data.Int (Int64)
+import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
+import Data.Time (UTCTime)
 import Data.Time.Clock (getCurrentTime)
-import Database.Persist
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import qualified Data.Text as T
+import qualified Database.SQLite.Simple as SQLite
 
-import Model.Database
-import qualified Model.Json.PaymentCategory as Json
+import Model.Category (CategoryId)
+import Model.Query (Query(Query))
 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
-
-save :: Text -> CategoryId -> Persist ()
-save newName category = do
-  now <- liftIO getCurrentTime
-  mbPaymentCategory <- selectFirst [PaymentCategoryName ==. (formatPaymentName newName)] []
-  if isJust mbPaymentCategory
-    then
-      updateWhere
-        [ 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
+type PaymentCategoryId = Int64
+
+data PaymentCategory = PaymentCategory
+  { id :: PaymentCategoryId
+  , name :: Text
+  , category :: CategoryId
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  } deriving Show
+
+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 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