From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- server/src/Persistence/Category.hs | 79 ++++++++++++++ server/src/Persistence/Frequency.hs | 23 ++++ server/src/Persistence/Income.hs | 88 ++++++++++++++++ server/src/Persistence/Init.hs | 25 +++++ server/src/Persistence/Payment.hs | 169 ++++++++++++++++++++++++++++++ server/src/Persistence/PaymentCategory.hs | 66 ++++++++++++ server/src/Persistence/User.hs | 37 +++++++ 7 files changed, 487 insertions(+) create mode 100644 server/src/Persistence/Category.hs create mode 100644 server/src/Persistence/Frequency.hs create mode 100644 server/src/Persistence/Income.hs create mode 100644 server/src/Persistence/Init.hs create mode 100644 server/src/Persistence/Payment.hs create mode 100644 server/src/Persistence/PaymentCategory.hs create mode 100644 server/src/Persistence/User.hs (limited to 'server/src/Persistence') 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) + ) -- cgit v1.2.3