Replace persistent by sqlite-simple

1 files changed, 142 insertions, 78 deletions

diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index d8caaa8..88df477 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,100 +1,164 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Model.Payment
-  ( find
+  ( PaymentId
+  , Payment(..)
+  , find
   , list
   , listMonthly
   , create
+  , createMany
   , editOwn
   , deleteOwn
   , modifiedDuring
   ) where
 
+import Data.Int (Int64)
+import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Time (UTCTime)
-import Data.Time.Clock (getCurrentTime)
 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 Control.Monad.IO.Class (liftIO)
+import Model.Frequency
+import Model.Query (Query(Query))
+import Model.User (UserId)
+import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-import Database.Persist
+type PaymentId = Int64
 
-import Model.Database
-import Model.Frequency
-import qualified Model.Json.Payment as P
+data Payment = Payment
+  { id :: PaymentId
+  , userId :: UserId
+  , name :: Text
+  , cost :: Int
+  , date :: Day
+  , frequency :: Frequency
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  , deletedAt :: Maybe UTCTime
+  } deriving Show
 
-find :: PaymentId -> Persist (Maybe (Entity Payment))
-find paymentId = selectFirst [ PaymentId ==. paymentId ] []
+instance Resource Payment where
+  resourceCreatedAt = createdAt
+  resourceEditedAt = editedAt
+  resourceDeletedAt = deletedAt
 
-list :: Persist [P.Payment]
-list = map getJsonPayment <$> selectList [ PaymentDeletedAt ==. Nothing ] []
+instance FromRow Payment where
+  fromRow = Payment <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
 
-listMonthly :: Persist [Entity Payment]
-listMonthly =
-  selectList
-    [ PaymentDeletedAt ==. Nothing
-    , PaymentFrequency ==. Monthly
+instance ToRow Payment where
+  toRow p =
+    [ toField (userId p)
+    , toField (name p)
+    , toField (cost p)
+    , toField (date p)
+    , toField (frequency p)
+    , toField (createdAt p)
+    , toField (createdAt p)
     ]
-    [ Desc PaymentName ]
-
-getJsonPayment :: Entity Payment -> P.Payment
-getJsonPayment paymentEntity =
-  let payment = entityVal paymentEntity
-  in  P.Payment
-        { P.id = entityKey paymentEntity
-        , P.date = paymentDate payment
-        , P.name = paymentName payment
-        , P.cost = paymentCost payment
-        , P.userId = paymentUserId payment
-        , P.frequency = paymentFrequency payment
-        }
-
-create :: UserId -> Text -> Int -> Day -> Frequency -> Persist PaymentId
-create userId name cost date frequency = do
-  now <- liftIO getCurrentTime
-  insert (Payment userId name cost date frequency now Nothing Nothing)
-
-editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Persist Bool
-editOwn userId paymentId name cost date frequency = do
-  mbPayment <- get paymentId
-  case mbPayment of
-    Just payment ->
-      if paymentUserId payment == userId
-        then do
-          now <- liftIO getCurrentTime
-          update paymentId
-            [ PaymentEditedAt =. Just now
-            , PaymentName =. name
-            , PaymentCost =. cost
-            , PaymentDate =. date
-            , PaymentFrequency =. frequency
-            ]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
-
-deleteOwn :: UserId -> PaymentId -> Persist Bool
-deleteOwn userId paymentId = do
-  mbPayment <- get paymentId
-  case mbPayment of
-    Just payment ->
-      if paymentUserId payment == userId
-        then do
-          now <- liftIO getCurrentTime
-          update paymentId [PaymentDeletedAt =. Just now]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
-
-modifiedDuring :: UTCTime -> UTCTime -> Persist [Payment]
+
+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
+      "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 paymentUserId paymentName paymentCost paymentDate paymentFrequency =
+  Query (\conn -> do
+    now <- getCurrentTime
+    SQLite.execute
+      conn
+      "INSERT INTO payment (user_id, name, cost, date, frequency, created_at) VALUES (?, ?, ?, ?, ?, ?)"
+      (paymentUserId, paymentName, paymentCost, paymentDate, paymentFrequency, now)
+    SQLite.lastInsertRowId conn
+  )
+
+createMany :: [Payment] -> Query ()
+createMany payments =
+  Query (\conn ->
+    SQLite.executeMany
+      conn
+      "INSERT INTO payment (user_id, name, cost, date, frequency, created_at) VALUES (?, ?, ?, ?, ?, ?)"
+      payments
+  )
+
+editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
+editOwn paymentUserId 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 userId payment == paymentUserId
+          then do
+            now <- getCurrentTime
+            SQLite.execute
+              conn
+              "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 paymentUserId paymentId =
+  Query (\conn -> do
+    mbPayment <- listToMaybe <$>
+      SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
+    case mbPayment of
+      Just payment ->
+        if userId payment == paymentUserId
+          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 =
-  map entityVal <$> selectList
-    (   [PaymentFrequency ==. Punctual, PaymentCreatedAt >=. start, PaymentCreatedAt <. end]
-    ||. [PaymentFrequency ==. Punctual, PaymentEditedAt >=. Just start, PaymentEditedAt <. Just end]
-    ||. [PaymentFrequency ==. Punctual, PaymentDeletedAt >=. Just start, PaymentDeletedAt <. Just end]
-    )
-    []
+  Query (\conn ->
+    SQLite.query
+      conn
+      "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)
+  )