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/Payment.hs | 169 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 169 insertions(+)
 create mode 100644 server/src/Persistence/Payment.hs

(limited to 'server/src/Persistence/Payment.hs')

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
+  )
-- 
cgit v1.2.3