aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--client/src/Component/Input.hs2
-rw-r--r--client/src/Component/Table.hs9
-rw-r--r--client/src/View/Category/Category.hs34
-rw-r--r--client/src/View/Category/Table.hs16
-rw-r--r--client/src/View/Income/Table.hs3
-rw-r--r--client/src/View/Payment/Table.hs3
-rw-r--r--common/src/Common/Model/CategoryPage.hs9
-rw-r--r--common/src/Common/Validation/Atomic.hs9
-rw-r--r--server/src/Controller/Category.hs5
-rw-r--r--server/src/Persistence/Category.hs64
-rw-r--r--server/src/Persistence/Payment.hs14
11 files changed, 107 insertions, 61 deletions
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 37020da..bcff377 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -57,7 +57,7 @@ view input reset validate = do
]
inputAttr = R.ffor value (\v ->
- if T.null v && _in_inputType input /= "date"
+ if T.null v && _in_inputType input /= "date" && _in_inputType input /= "color"
then M.empty
else M.singleton "class" "filled")
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index f82cfa6..1482f91 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -21,7 +21,8 @@ data In m t h r = In
, _in_cloneModal :: r -> Modal.Content t m
, _in_editModal :: r -> Modal.Content t m
, _in_deleteModal :: r -> Modal.Content t m
- , _in_isOwner :: r -> Bool
+ , _in_canEdit :: r -> Bool
+ , _in_canDelete :: r -> Bool
}
data Out t = Out
@@ -62,8 +63,6 @@ view input =
, Modal._in_content = _in_cloneModal input row
}
- let isOwner = _in_isOwner input row
-
let visibleIf cond =
R.elAttr
"div"
@@ -71,7 +70,7 @@ view input =
editButton <-
R.divClass "cell button" $
- visibleIf isOwner $
+ visibleIf (_in_canEdit input row) $
Button._out_clic <$> (Button.view $
Button.defaultIn Icon.edit)
@@ -83,7 +82,7 @@ view input =
deleteButton <-
R.divClass "cell button" $
- visibleIf isOwner $
+ visibleIf (_in_canDelete input row) $
Button._out_clic <$> (Button.view $
Button.defaultIn Icon.delete)
diff --git a/client/src/View/Category/Category.hs b/client/src/View/Category/Category.hs
index 77a331a..5b41bb6 100644
--- a/client/src/View/Category/Category.hs
+++ b/client/src/View/Category/Category.hs
@@ -53,13 +53,14 @@ view input = do
deleteCategory <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
result <- Loadable.viewShowValueWhileLoading categoryPage $
- \(CategoryPage page categories count) -> do
+ \(CategoryPage page categories usedCategories count) -> do
header <- headerView
table <- Table.view $ Table.In
{ Table._in_currentUser = _in_currentUser input
, Table._in_currency = _in_currency input
, Table._in_categories = categories
+ , Table._in_usedCategories = usedCategories
, Table._in_users = _in_users input
}
@@ -75,18 +76,19 @@ view input = do
headerView :: forall t m. MonadWidget t m => m (Event t ())
headerView =
- R.divClass "titleButton" $ do
- R.el "h1" $
- R.text $
- Msg.get Msg.Category_Title
-
- addCategory <- Button._out_clic <$>
- (Button.view . Button.defaultIn . R.text $
- Msg.get Msg.Category_Add)
-
- addCategory <- Modal.view $ Modal.In
- { Modal._in_show = addCategory
- , Modal._in_content = Form.view $ Form.In { Form._in_operation = Form.New }
- }
-
- return addCategory
+ R.divClass "withMargin" $
+ R.divClass "titleButton" $ do
+ R.el "h1" $
+ R.text $
+ Msg.get Msg.Category_Title
+
+ addCategory <- Button._out_clic <$>
+ (Button.view . Button.defaultIn . R.text $
+ Msg.get Msg.Category_Add)
+
+ addCategory <- Modal.view $ Modal.In
+ { Modal._in_show = addCategory
+ , Modal._in_content = Form.view $ Form.In { Form._in_operation = Form.New }
+ }
+
+ return addCategory
diff --git a/client/src/View/Category/Table.hs b/client/src/View/Category/Table.hs
index fbe76e9..90d013d 100644
--- a/client/src/View/Category/Table.hs
+++ b/client/src/View/Category/Table.hs
@@ -10,8 +10,8 @@ import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Category (..), Currency, User (..),
- UserId)
+import Common.Model (Category (..), CategoryId, Currency,
+ User (..), UserId)
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
@@ -24,10 +24,11 @@ import qualified Util.Either as EitherUtil
import qualified View.Category.Form as Form
data In t = In
- { _in_currentUser :: UserId
- , _in_currency :: Currency
- , _in_categories :: [Category]
- , _in_users :: [User]
+ { _in_currentUser :: UserId
+ , _in_currency :: Currency
+ , _in_categories :: [Category]
+ , _in_usedCategories :: [CategoryId]
+ , _in_users :: [User]
}
data Out t = Out
@@ -60,7 +61,8 @@ view input = do
e
return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
}
- , Table._in_isOwner = const True
+ , Table._in_canEdit = const True
+ , Table._in_canDelete = not . flip elem (_in_usedCategories input) . _category_id
}
return $ Out
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index c7f172b..7b7940d 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -59,7 +59,8 @@ view input = do
e
return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
}
- , Table._in_isOwner = (== (_in_currentUser input)) . _income_userId
+ , Table._in_canEdit = (== (_in_currentUser input)) . _income_userId
+ , Table._in_canDelete = (== (_in_currentUser input)) . _income_userId
}
return $ Out
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 6744d3a..bfa0fb9 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -74,7 +74,8 @@ view input = do
e
return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
}
- , Table._in_isOwner = (== (_in_currentUser input)) . _payment_user
+ , Table._in_canEdit = (== (_in_currentUser input)) . _payment_user
+ , Table._in_canDelete = (== (_in_currentUser input)) . _payment_user
}
return $ Out
diff --git a/common/src/Common/Model/CategoryPage.hs b/common/src/Common/Model/CategoryPage.hs
index 476b4ce..e20f49f 100644
--- a/common/src/Common/Model/CategoryPage.hs
+++ b/common/src/Common/Model/CategoryPage.hs
@@ -5,12 +5,13 @@ module Common.Model.CategoryPage
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
-import Common.Model.Category (Category)
+import Common.Model.Category (Category, CategoryId)
data CategoryPage = CategoryPage
- { _categoryPage_page :: Int
- , _categoryPage_categories :: [Category]
- , _categoryPage_totalCount :: Int
+ { _categoryPage_page :: Int
+ , _categoryPage_categories :: [Category]
+ , _categoryPage_usedCategories :: [CategoryId]
+ , _categoryPage_totalCount :: Int
} deriving (Eq, Show, Generic)
instance FromJSON CategoryPage
diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs
index 2a356df..4bb7cad 100644
--- a/common/src/Common/Validation/Atomic.hs
+++ b/common/src/Common/Validation/Atomic.hs
@@ -7,6 +7,7 @@ module Common.Validation.Atomic
, color
) where
+import qualified Data.Char as Char
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day)
@@ -47,6 +48,10 @@ day str =
Just d -> V.Success d
Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate
--- TODO: validate
color :: Text -> Validation Text Text
-color str = V.Success str
+color str =
+ if T.take 1 str == "#" && T.all Char.isHexDigit (T.drop 1 str) then
+ V.Success str
+
+ else
+ V.Failure (Msg.get Msg.Form_InvalidColor)
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-03 10:12:10 +0000