1 files changed, 175 insertions, 0 deletions
diff --git a/server/src/Model/Payment.hs b/server/src/Model/Payment.hs
new file mode 100644
index 0000000..14efe77
--- /dev/null
+++ b/server/src/Model/Payment.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Model.Payment
+  ( Payment(..)
+  , find
+  , list
+  , listMonthly
+  , create
+  , createMany
+  , editOwn
+  , deleteOwn
+  , modifiedDuring
+  ) where
+
+import Data.Maybe (listToMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time (UTCTime)
+import Data.Time.Calendar (Day)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow), ToRow)
+import Database.SQLite.Simple.ToField (ToField(toField))
+import Prelude hiding (id)
+import qualified Database.SQLite.Simple as SQLite
+
+import Common.Model (Frequency(..), Payment(..), PaymentId, UserId)
+
+import Model.Frequency ()
+import Model.Query (Query(Query))
+import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
+
+instance Resource Payment where
+  resourceCreatedAt = _payment_createdAt
+  resourceEditedAt = _payment_editedAt
+  resourceDeletedAt = _payment_deletedAt
+
+instance FromRow Payment where
+  fromRow = Payment <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
+
+instance ToRow Payment where
+  toRow p =
+    [ toField (_payment_user p)
+    , toField (_payment_name p)
+    , toField (_payment_cost p)
+    , toField (_payment_date p)
+    , toField (_payment_frequency p)
+    , toField (_payment_createdAt p)
+    ]
+
+find :: PaymentId -> Query (Maybe Payment)
+find paymentId =
+  Query (\conn -> listToMaybe <$>
+    SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
+  )
+
+list :: Query [Payment]
+list =
+  Query (\conn ->
+    SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
+  )
+
+listMonthly :: Query [Payment]
+listMonthly =
+  Query (\conn ->
+    SQLite.query
+      conn
+      (SQLite.Query $ T.intercalate " "
+        [ "SELECT *"
+        , "FROM payment"
+        , "WHERE deleted_at IS NULL AND frequency = ?"
+        , "ORDER BY name DESC"
+        ])
+      (Only 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, 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 (?, ?, ?, ?, ?, ?)"
+        ])
+      payments
+  )
+
+editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
+editOwn userId paymentId paymentName paymentCost paymentDate paymentFrequency =
+  Query (\conn -> do
+    mbPayment <- 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, 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 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
+  )
+
+modifiedDuring :: UTCTime -> UTCTime -> Query [Payment]
+modifiedDuring start end =
+  Query (\conn ->
+    SQLite.query
+      conn
+      (SQLite.Query $ T.intercalate " "
+        [ "SELECT *"
+        , "FROM payment"
+        , "WHERE (created_at >= ? AND created_at <= ?)"
+        , "   OR (edited_at >= ?  AND edited_at <= ?)"
+        , "   OR (deleted_at >= ? AND deleted_at <= ?)"
+        ])
+      (start, end, start, end, start, end)
+  )