From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 8 Nov 2017 23:47:26 +0100 Subject: Use a better project structure --- server/src/Model/PaymentCategory.hs | 62 +++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) create mode 100644 server/src/Model/PaymentCategory.hs (limited to 'server/src/Model/PaymentCategory.hs') diff --git a/server/src/Model/PaymentCategory.hs b/server/src/Model/PaymentCategory.hs new file mode 100644 index 0000000..6e1d304 --- /dev/null +++ b/server/src/Model/PaymentCategory.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Model.PaymentCategory + ( list + , listByCategory + , save + ) where + +import Data.Maybe (isJust, listToMaybe) +import Data.Text (Text) +import Data.Time.Clock (getCurrentTime) +import Database.SQLite.Simple (Only(Only), FromRow(fromRow)) +import qualified Data.Text as T +import qualified Database.SQLite.Simple as SQLite + +import Common.Model (CategoryId, PaymentCategory(..)) +import qualified Common.Util.Text as T + +import Model.Query (Query(Query)) + +instance FromRow PaymentCategory where + fromRow = PaymentCategory <$> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field + +list :: Query [PaymentCategory] +list = Query (\conn -> SQLite.query_ conn "SELECT * from payment_category") + +listByCategory :: CategoryId -> Query [PaymentCategory] +listByCategory cat = + Query (\conn -> + SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat) + ) + +save :: Text -> CategoryId -> Query () +save newName categoryId = + Query (\conn -> do + now <- getCurrentTime + mbPaymentCategory <- listToMaybe <$> + (SQLite.query + conn + "SELECT * FROM payment_category WHERE name = ?" + (Only (formatPaymentName newName)) :: IO [PaymentCategory]) + if isJust mbPaymentCategory + then + SQLite.execute + conn + "UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?" + (categoryId, now, formatPaymentName newName) + else do + SQLite.execute + conn + "INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)" + (formatPaymentName newName, categoryId, now) + ) + where + formatPaymentName :: Text -> Text + formatPaymentName = T.unaccent . T.toLower -- cgit v1.2.3