diff options
author | Joris | 2017-03-24 09:21:06 +0000 |
---|---|---|
committer | Joris | 2017-03-24 09:21:06 +0000 |
commit | c0ac16a713c4e53cf6af8e72a6d5f6b8ac5d6456 (patch) | |
tree | 8a438430cee7411259fc395d8f3898488e85d750 /src/server/Model/PaymentCategory.hs | |
parent | 293eb8295162bf0a038f488237db9c9d1316c04d (diff) | |
parent | cfca18262c1ff48dcb683ddab7d03cf8e55573ff (diff) | |
download | budget-c0ac16a713c4e53cf6af8e72a6d5f6b8ac5d6456.tar.gz budget-c0ac16a713c4e53cf6af8e72a6d5f6b8ac5d6456.tar.bz2 budget-c0ac16a713c4e53cf6af8e72a6d5f6b8ac5d6456.zip |
Merge branch 'features/categories' into 'master'
Features/categories
See merge request !1
Diffstat (limited to 'src/server/Model/PaymentCategory.hs')
-rw-r--r-- | src/server/Model/PaymentCategory.hs | 55 |
1 files changed, 55 insertions, 0 deletions
diff --git a/src/server/Model/PaymentCategory.hs b/src/server/Model/PaymentCategory.hs new file mode 100644 index 0000000..6df77e2 --- /dev/null +++ b/src/server/Model/PaymentCategory.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.PaymentCategory + ( list + , listByCategory + , set + , edit + , delete + ) where + +import Data.Maybe (isJust) +import Data.Text (Text) +import Data.Time.Clock (getCurrentTime) +import qualified Data.Text as T + +import Control.Monad.IO.Class (liftIO) + +import Database.Persist + +import Model.Database +import qualified Model.Json.PaymentCategory as Json +import qualified Utils.Text as T + +list :: Persist [Json.PaymentCategory] +list = map getJsonPaymentCategory <$> selectList [] [] + +listByCategory :: CategoryId -> Persist [Entity PaymentCategory] +listByCategory category = selectList [ PaymentCategoryCategory ==. category ] [] + +getJsonPaymentCategory :: Entity PaymentCategory -> Json.PaymentCategory +getJsonPaymentCategory entity = + Json.PaymentCategory (paymentCategoryName pc) (paymentCategoryCategory pc) + where pc = entityVal entity + +set :: Text -> CategoryId -> Persist () +set name category = edit name name category + +edit :: Text -> Text -> CategoryId -> Persist () +edit oldName newName category = do + now <- liftIO getCurrentTime + mbPaymentCategory <- selectFirst [PaymentCategoryName ==. (formatPaymentName oldName)] [] + if isJust mbPaymentCategory + then + updateWhere + [ PaymentCategoryName ==. (formatPaymentName oldName) ] + [ PaymentCategoryName =. (formatPaymentName newName) + , PaymentCategoryCategory =. category + , PaymentCategoryEditedAt =. Just now + ] + else do + _ <- insert $ PaymentCategory (formatPaymentName newName) category now Nothing + return () + +formatPaymentName :: Text -> Text +formatPaymentName = T.unaccent . T.toLower |