From 0b191f5c48edffc9da3e38c284e9640fd82e7cb1 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 5 Jun 2017 18:02:13 +0200 Subject: Replace persistent by sqlite-simple --- src/server/Model/Payment.hs | 220 ++++++++++++++++++++++++++++---------------- 1 file changed, 142 insertions(+), 78 deletions(-) (limited to 'src/server/Model/Payment.hs') 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) + ) -- cgit v1.2.3