aboutsummaryrefslogtreecommitdiff
path: root/server/src/Persistence
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Persistence')
-rw-r--r--server/src/Persistence/Category.hs79
-rw-r--r--server/src/Persistence/Frequency.hs23
-rw-r--r--server/src/Persistence/Income.hs88
-rw-r--r--server/src/Persistence/Init.hs25
-rw-r--r--server/src/Persistence/Payment.hs169
-rw-r--r--server/src/Persistence/PaymentCategory.hs66
-rw-r--r--server/src/Persistence/User.hs37
7 files changed, 487 insertions, 0 deletions
diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs
new file mode 100644
index 0000000..2afe5db
--- /dev/null
+++ b/server/src/Persistence/Category.hs
@@ -0,0 +1,79 @@
+module Persistence.Category
+ ( list
+ , create
+ , edit
+ , delete
+ ) where
+
+import Data.Maybe (isJust, listToMaybe)
+import Data.Text (Text)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (FromRow (fromRow), Only (Only))
+import qualified Database.SQLite.Simple as SQLite
+import Prelude hiding (id)
+
+import Common.Model (Category (..), CategoryId)
+
+import Model.Query (Query (Query))
+
+newtype Row = Row Category
+
+instance FromRow Row where
+ fromRow = Row <$> (Category <$>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field)
+
+list :: Query [Category]
+list =
+ Query (\conn ->
+ map (\(Row c) -> c) <$>
+ SQLite.query_ conn "SELECT * FROM category WHERE deleted_at IS NULL"
+ )
+
+create :: Text -> Text -> Query CategoryId
+create categoryName categoryColor =
+ Query (\conn -> do
+ now <- getCurrentTime
+ SQLite.execute
+ conn
+ "INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)"
+ (categoryName, categoryColor, now)
+ SQLite.lastInsertRowId conn
+ )
+
+edit :: CategoryId -> Text -> Text -> Query Bool
+edit categoryId categoryName categoryColor =
+ Query (\conn -> do
+ mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$>
+ (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
+ if isJust mbCategory
+ then do
+ now <- getCurrentTime
+ SQLite.execute
+ conn
+ "UPDATE category SET edited_at = ?, name = ?, color = ? WHERE id = ?"
+ (now, categoryName, categoryColor, categoryId)
+ return True
+ else
+ return False
+ )
+
+delete :: CategoryId -> Query Bool
+delete categoryId =
+ Query (\conn -> do
+ mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$>
+ (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
+ if isJust mbCategory
+ then do
+ now <- getCurrentTime
+ SQLite.execute
+ conn
+ "UPDATE category SET deleted_at = ? WHERE id = ?" (now, categoryId)
+ return True
+ else
+ return False
+ )
diff --git a/server/src/Persistence/Frequency.hs b/server/src/Persistence/Frequency.hs
new file mode 100644
index 0000000..edaa844
--- /dev/null
+++ b/server/src/Persistence/Frequency.hs
@@ -0,0 +1,23 @@
+module Persistence.Frequency
+ ( FrequencyField(..)
+ ) where
+
+import qualified Data.Text as T
+import Database.SQLite.Simple (SQLData (SQLText))
+import Database.SQLite.Simple.FromField (FromField (fromField),
+ fieldData)
+import Database.SQLite.Simple.Ok (Ok (Errors, Ok))
+import Database.SQLite.Simple.ToField (ToField (toField))
+
+import Common.Model (Frequency)
+
+newtype FrequencyField = FrequencyField Frequency
+
+instance FromField FrequencyField where
+ fromField field =
+ case fieldData field of
+ SQLText text -> Ok (FrequencyField (read (T.unpack text) :: Frequency))
+ _ -> Errors [error "SQLText field required for frequency"]
+
+instance ToField FrequencyField where
+ toField (FrequencyField f) = SQLText . T.pack . show $ f
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
new file mode 100644
index 0000000..a863f85
--- /dev/null
+++ b/server/src/Persistence/Income.hs
@@ -0,0 +1,88 @@
+module Persistence.Income
+ ( list
+ , create
+ , editOwn
+ , deleteOwn
+ ) where
+
+import Data.Maybe (listToMaybe)
+import Data.Time.Calendar (Day)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (FromRow (fromRow), Only (Only))
+import qualified Database.SQLite.Simple as SQLite
+import Prelude hiding (id)
+
+import Common.Model (Income (..), IncomeId, User (..),
+ UserId)
+
+import Model.Query (Query (Query))
+
+newtype Row = Row Income
+
+instance FromRow Row where
+ fromRow = Row <$> (Income <$>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field)
+
+list :: Query [Income]
+list =
+ Query (\conn ->
+ map (\(Row i) -> i) <$>
+ SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
+ )
+
+create :: UserId -> Day -> Int -> Query IncomeId
+create incomeUserId incomeDate incomeAmount =
+ Query (\conn -> do
+ now <- getCurrentTime
+ SQLite.execute
+ conn
+ "INSERT INTO income (user_id, date, amount, created_at) VALUES (?, ?, ?, ?)"
+ (incomeUserId, incomeDate, incomeAmount, now)
+ SQLite.lastInsertRowId conn
+ )
+
+editOwn :: UserId -> IncomeId -> Day -> Int -> Query Bool
+editOwn incomeUserId incomeId incomeDate incomeAmount =
+ Query (\conn -> do
+ mbIncome <- fmap (\(Row i) -> i) . listToMaybe <$>
+ SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
+ case mbIncome of
+ Just income ->
+ if _income_userId income == incomeUserId
+ then do
+ now <- getCurrentTime
+ SQLite.execute
+ conn
+ "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ?"
+ (now, incomeDate, incomeAmount, incomeId)
+ return True
+ else
+ return False
+ Nothing ->
+ return False
+ )
+
+deleteOwn :: User -> IncomeId -> Query Bool
+deleteOwn user incomeId =
+ Query (\conn -> do
+ mbIncome <-
+ fmap (\(Row i) -> i) . listToMaybe <$>
+ SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
+ case mbIncome of
+ Just income ->
+ if _income_userId income == _user_id user
+ then do
+ now <- getCurrentTime
+ SQLite.execute conn "UPDATE income SET deleted_at = ? WHERE id = ?" (now, incomeId)
+ return True
+ else
+ return False
+ Nothing ->
+ return False
+ )
diff --git a/server/src/Persistence/Init.hs b/server/src/Persistence/Init.hs
new file mode 100644
index 0000000..74d9172
--- /dev/null
+++ b/server/src/Persistence/Init.hs
@@ -0,0 +1,25 @@
+module Persistence.Init
+ ( getInit
+ ) where
+
+import Common.Model (Init (Init), User (..))
+
+import Conf (Conf)
+import qualified Conf
+import Model.Query (Query)
+import qualified Persistence.Category as CategoryPersistence
+import qualified Persistence.Income as IncomePersistence
+import qualified Persistence.Payment as PaymentPersistence
+import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
+import qualified Persistence.User as UserPersistence
+
+getInit :: User -> Conf -> Query Init
+getInit user conf =
+ Init <$>
+ UserPersistence.list <*>
+ (return . _user_id $ user) <*>
+ PaymentPersistence.listActive <*>
+ IncomePersistence.list <*>
+ CategoryPersistence.list <*>
+ PaymentCategoryPersistence.list <*>
+ (return . Conf.currency $ conf)
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
new file mode 100644
index 0000000..32600d7
--- /dev/null
+++ b/server/src/Persistence/Payment.hs
@@ -0,0 +1,169 @@
+module Persistence.Payment
+ ( Payment(..)
+ , find
+ , listActive
+ , listPunctual
+ , listActiveMonthlyOrderedByName
+ , create
+ , createMany
+ , editOwn
+ , deleteOwn
+ ) where
+
+import Data.Maybe (listToMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Calendar (Day)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (FromRow (fromRow), Only (Only),
+ ToRow)
+import qualified Database.SQLite.Simple as SQLite
+import Database.SQLite.Simple.ToField (ToField (toField))
+import Prelude hiding (id)
+
+import Common.Model (Frequency (..), Payment (..),
+ PaymentId, UserId)
+
+import Model.Query (Query (Query))
+import Persistence.Frequency (FrequencyField (..))
+
+newtype Row = Row Payment
+
+instance FromRow Row where
+ fromRow = Row <$> (Payment <$>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ (fmap (\(FrequencyField f) -> f) $ SQLite.field) <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field)
+
+newtype InsertRow = InsertRow Payment
+
+instance ToRow InsertRow where
+ toRow (InsertRow p) =
+ [ toField (_payment_user p)
+ , toField (_payment_name p)
+ , toField (_payment_cost p)
+ , toField (_payment_date p)
+ , toField (FrequencyField (_payment_frequency p))
+ , toField (_payment_createdAt p)
+ ]
+
+find :: PaymentId -> Query (Maybe Payment)
+find paymentId =
+ Query (\conn -> do
+ fmap (\(Row p) -> p) . listToMaybe <$>
+ SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
+ )
+
+listActive :: Query [Payment]
+listActive =
+ Query (\conn -> do
+ map (\(Row p) -> p) <$>
+ SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
+ )
+
+listPunctual :: Query [Payment]
+listPunctual =
+ Query (\conn -> do
+ map (\(Row p) -> p) <$>
+ SQLite.query
+ conn
+ (SQLite.Query "SELECT * FROM payment WHERE frequency = ?")
+ (Only (FrequencyField Punctual))
+ )
+
+listActiveMonthlyOrderedByName :: Query [Payment]
+listActiveMonthlyOrderedByName =
+ Query (\conn -> do
+ map (\(Row p) -> p) <$>
+ SQLite.query
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "SELECT *"
+ , "FROM payment"
+ , "WHERE deleted_at IS NULL AND frequency = ?"
+ , "ORDER BY name DESC"
+ ])
+ (Only (FrequencyField Monthly))
+ )
+
+create :: UserId -> Text -> Int -> Day -> Frequency -> Query PaymentId
+create userId paymentName paymentCost paymentDate paymentFrequency =
+ Query (\conn -> do
+ now <- getCurrentTime
+ SQLite.execute
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)"
+ , "VALUES (?, ?, ?, ?, ?, ?)"
+ ])
+ (userId, paymentName, paymentCost, paymentDate, FrequencyField paymentFrequency, now)
+ SQLite.lastInsertRowId conn
+ )
+
+createMany :: [Payment] -> Query ()
+createMany payments =
+ Query (\conn ->
+ SQLite.executeMany
+ conn
+ (SQLite.Query $ T.intercalate ""
+ [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)"
+ , "VALUES (?, ?, ?, ?, ?, ?)"
+ ])
+ (map InsertRow payments)
+ )
+
+editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
+editOwn userId paymentId paymentName paymentCost paymentDate paymentFrequency =
+ Query (\conn -> do
+ mbPayment <- fmap (\(Row p) -> p) . listToMaybe <$>
+ SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
+ case mbPayment of
+ Just payment ->
+ if _payment_user payment == userId
+ then do
+ now <- getCurrentTime
+ SQLite.execute
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "UPDATE payment"
+ , "SET edited_at = ?,"
+ , " name = ?,"
+ , " cost = ?,"
+ , " date = ?,"
+ , " frequency = ?"
+ , "WHERE id = ?"
+ ])
+ (now, paymentName, paymentCost, paymentDate, FrequencyField paymentFrequency, paymentId)
+ return True
+ else
+ return False
+ Nothing ->
+ return False
+ )
+
+deleteOwn :: UserId -> PaymentId -> Query Bool
+deleteOwn userId paymentId =
+ Query (\conn -> do
+ mbPayment <- listToMaybe <$>
+ SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
+ case mbPayment of
+ Just (Row payment) ->
+ if _payment_user payment == userId
+ then do
+ now <- getCurrentTime
+ SQLite.execute
+ conn
+ "UPDATE payment SET deleted_at = ? WHERE id = ?"
+ (now, paymentId)
+ return True
+ else
+ return False
+ Nothing ->
+ return False
+ )
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
diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs
new file mode 100644
index 0000000..4ec2dcf
--- /dev/null
+++ b/server/src/Persistence/User.hs
@@ -0,0 +1,37 @@
+module Persistence.User
+ ( list
+ , get
+ ) where
+
+import Data.Maybe (listToMaybe)
+import Data.Text (Text)
+import Database.SQLite.Simple (FromRow (fromRow), Only (Only))
+import qualified Database.SQLite.Simple as SQLite
+import Prelude hiding (id)
+
+import Common.Model (User (..))
+
+import Model.Query (Query (Query))
+
+newtype Row = Row User
+
+instance FromRow Row where
+ fromRow = Row <$> (User <$>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field)
+
+list :: Query [User]
+list =
+ Query (\conn -> do
+ map (\(Row u) -> u) <$>
+ SQLite.query_ conn "SELECT * from user ORDER BY creation DESC"
+ )
+
+get :: Text -> Query (Maybe User)
+get userEmail =
+ Query (\conn -> do
+ fmap (\(Row u) -> u) . listToMaybe <$>
+ SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
+ )
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 00:53:09 +0000