diff options
Diffstat (limited to 'server/src')
-rw-r--r-- | server/src/Controller/Category.hs | 5 | ||||
-rw-r--r-- | server/src/Persistence/Category.hs | 64 | ||||
-rw-r--r-- | server/src/Persistence/Payment.hs | 14 |
3 files changed, 59 insertions, 24 deletions
diff --git a/server/src/Controller/Category.hs b/server/src/Controller/Category.hs index 36ce3fc..371ba78 100644 --- a/server/src/Controller/Category.hs +++ b/server/src/Controller/Category.hs @@ -22,6 +22,7 @@ import Model.CreateCategory (CreateCategory (..)) import Model.EditCategory (EditCategory (..)) import qualified Model.Query as Query import qualified Persistence.Category as CategoryPersistence +import qualified Persistence.Payment as PaymentPersistence import qualified Secure import qualified Validation.Category as CategoryValidation @@ -36,8 +37,9 @@ list page perPage = Secure.loggedAction (\_ -> (liftIO . Query.run $ do categories <- CategoryPersistence.list page perPage + usedCategories <- PaymentPersistence.usedCategories count <- CategoryPersistence.count - return $ CategoryPage page categories count + return $ CategoryPage page categories usedCategories count ) >>= json ) @@ -76,7 +78,6 @@ delete :: CategoryId -> ActionM () delete categoryId = Secure.loggedAction (\_ -> do deleted <- liftIO . Query.run $ do - -- TODO: delete only if no payment has this category CategoryPersistence.delete categoryId if deleted then diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs index 2934b28..b0a6fca 100644 --- a/server/src/Persistence/Category.hs +++ b/server/src/Persistence/Category.hs @@ -10,7 +10,7 @@ module Persistence.Category import qualified Data.Maybe as Maybe import Data.Text (Text) import Data.Time.Clock (getCurrentTime) -import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) +import Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=))) import qualified Database.SQLite.Simple as SQLite import Prelude hiding (id) @@ -46,10 +46,12 @@ list :: Int -> Int -> Query [Category] list page perPage = Query (\conn -> map (\(Row c) -> c) <$> - SQLite.query + SQLite.queryNamed conn - "SELECT * FROM category WHERE deleted_at IS NULL ORDER BY edited_at, created_at DESC LIMIT ? OFFSET ?" - (perPage, (page - 1) * perPage) + "SELECT * FROM category WHERE deleted_at IS NULL ORDER BY name LIMIT :limit OFFSET :offset" + [ ":limit" := perPage + , ":offset" := (page - 1) * perPage + ] ) listAll :: Query [Category] @@ -60,43 +62,61 @@ listAll = ) create :: Text -> Text -> Query () -create categoryName categoryColor = +create name color = Query (\conn -> do - now <- getCurrentTime - SQLite.execute + currentTime <- getCurrentTime + SQLite.executeNamed conn - "INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)" - (categoryName, categoryColor, now) + "INSERT INTO category (name, color, created_at) VALUES (:name, :color, :created_at)" + [ ":name" := name + , ":color" := color + , ":created_at" := currentTime + ] ) edit :: CategoryId -> Text -> Text -> Query Bool -edit categoryId categoryName categoryColor = +edit id name color = Query (\conn -> do mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$> - (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId)) + (SQLite.queryNamed conn "SELECT * FROM category WHERE id = :id" [ ":id" := id ]) if Maybe.isJust mbCategory then do - now <- getCurrentTime - SQLite.execute + currentTime <- getCurrentTime + SQLite.executeNamed conn - "UPDATE category SET edited_at = ?, name = ?, color = ? WHERE id = ?" - (now, categoryName, categoryColor, categoryId) + "UPDATE category SET edited_at = :editedAt, name = :name, color = :color WHERE id = :id" + [ ":editedAt" := currentTime + , ":name" := name + , ":color" := color + , ":id" := id + ] return True else return False ) +data BoolRow = BoolRow Int + +instance FromRow BoolRow where + fromRow = BoolRow <$> SQLite.field + delete :: CategoryId -> Query Bool -delete categoryId = +delete id = Query (\conn -> do - mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$> - (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId)) - if Maybe.isJust mbCategory + mbPayment <- (fmap (\(BoolRow b) -> b) . Maybe.listToMaybe) <$> + (SQLite.queryNamed + conn + "SELECT true FROM payment WHERE category = :id AND deleted_at IS NULL" + [ ":id" := id ]) + if Maybe.isNothing mbPayment then do - now <- getCurrentTime - SQLite.execute + currentTime <- getCurrentTime + SQLite.executeNamed conn - "UPDATE category SET deleted_at = ? WHERE id = ?" (now, categoryId) + "UPDATE category SET deleted_at = :deletedAt WHERE id = :id AND deleted_at IS NULL" + [ ":deletedAt" := currentTime + , ":id" := id + ] return True else return False diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs index a0cd580..b3eb141 100644 --- a/server/src/Persistence/Payment.hs +++ b/server/src/Persistence/Payment.hs @@ -12,6 +12,7 @@ module Persistence.Payment , searchCategory , repartition , getPreAndPostPaymentRepartition + , usedCategories ) where import Data.Map (Map) @@ -310,6 +311,19 @@ searchCategory paymentName = ] ) +usedCategories :: Query [CategoryId] +usedCategories = + Query (\conn -> do + map (\(CategoryIdRow p) -> p) <$> + SQLite.query_ + conn + (SQLite.Query $ T.intercalate " " + [ "SELECT DISTINCT category" + , "FROM payment" + , "WHERE deleted_at IS NULL" + ]) + ) + data UserCostRow = UserCostRow (UserId, Int) instance FromRow UserCostRow where |