WIP

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)
+  )