qol improvements

This commit is contained in:
Stuce 2025-06-25 17:03:00 +01:00
parent ce2dd6c750
commit 81ca02948b
2 changed files with 56 additions and 24 deletions

View file

@ -12,6 +12,7 @@ module Handler.TodoEntry where
import Import
import Text.Read
import Database.Persist.Sql (rawExecute, fromSqlKey, toSqlKey)
import GHC.RTS.Flags (TraceFlags(user))
-- TODO: move this back to another handler
getHomeR :: Handler Html
getHomeR = do
@ -71,12 +72,21 @@ getTodolistR groupId = do
$maybe token <- mToken
<input type="hidden" name="_token" value="#{token}">
<button type="submit">add
<form action=@{AddUserR groupId} method="post">
<input type="text" name="user" placeholder="new user">
$maybe token <- mToken
<input type="hidden" name="_token" value="#{token}">
<button type="submit">share
<a href=@{EditTodolistR groupId}>Edit
|]
getTodolistItemsR :: GroupId -> TodolistId -> Handler Html
getTodolistItemsR groupId todolistId = do
items <- dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [])
mSortOption <- lookupSession "sort"
items <- case mSortOption of
(Just "value") -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Desc TodolistItemValue, Asc TodolistItemId])
_ -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Asc TodolistItemId])
mToken <- fmap reqToken getRequest
defaultLayout $ do
setTitle "items"
@ -97,7 +107,15 @@ getTodolistItemsR groupId todolistId = do
$maybe token <- mToken
<input type="hidden" name="_token" value="#{token}">
<button type="submit">add
<a href=@{EditTodolistItemsR groupId todolistId}>Edit list
<form action=@{TrimTodolistItemsR groupId todolistId} method="post">
$maybe token <- mToken
<input type="hidden" name="_token" value="#{token}">
<button type="submit">trim
<form action=@{SortTodolistItemsR groupId todolistId} method="post">
$maybe token <- mToken
<input type="hidden" name="_token" value="#{token}">
<button type="submit">sort
<a href=@{EditTodolistItemsR groupId todolistId}>Edit
|]
@ -132,11 +150,14 @@ getEditTodolistItemsR groupId todolistId = do
|]
postEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
postEditTodolistItemsR groupId todolistId = do
text <- runInputPost $ ireq textField "text"
let xs = getItems text todolistId
mText <- runInputPost $ iopt textField "text"
let xs = case mText of
(Just text) -> getItems text todolistId
Nothing -> []
dbIfAuth groupId (do
deleteWhere [TodolistItemTodolistId ==. todolistId]
insertMany_ xs)
redirect $ TodolistItemsR groupId todolistId
getEditTodolistR :: GroupId -> Handler Html
@ -206,10 +227,15 @@ postDeleteGroupR = do
text <- lookupPostParams "ids"
let ints = map (read . unpack) text :: [Int64]
let ids = map toSqlKey ints :: [GroupId]
-- TODO: make sure the user has access to it aswell (this only works now for single user)
-- TODO: make sure the user has access to it aswell (this only works now for single user), and handle group owned by many
runDB $ deleteWhere [GroupId <-. ids]
redirect EditGroupR
postAddUserR :: GroupId -> Handler Html
postAddUserR groupId= do
-- DB action
redirect $ TodolistR groupId
getText :: Entity TodolistItem -> Text
getText item =
if value then "[x] " <> name
@ -231,29 +257,32 @@ getItems text todolistId = map read (lines text)
"" -> error "empty name"
something -> filter (/= '\r') something
TodolistItem todolistId value name
postTrimTodolistItemsR :: GroupId -> TodolistId -> Handler Html
postTrimTodolistItemsR groupId todolistId = do
dbIfAuth groupId (deleteWhere [TodolistItemTodolistId ==. todolistId, TodolistItemValue ==. True])
redirect $ TodolistItemsR groupId todolistId
postSortTodolistItemsR :: GroupId -> TodolistId -> Handler Html
postSortTodolistItemsR groupId todolistId = do
mSession <- lookupSession "sort"
case mSession of
(Just "value") -> setSession "sort" "id"
_ -> setSession "sort" "value"
redirect $ TodolistItemsR groupId todolistId
-- TODO: complete implementation should short circuit if multi user is on but no user exist
-- getUserId :: Handler (Key User)
-- getUserId = do
-- mUser <- runDB $ getBy $ UniqueName "Stuce"
-- case mUser of
-- Nothing -> runDB $ insert $ User "Stuce"
-- Just u -> return $ entityKey u
-- TODO: use yesodAuth and clean this mess
getUserId :: Handler (Key User)
getUserId :: HandlerFor App (Key User)
getUserId = do
mName <- lookupHeader "Remote-User"
case mName of
-- TODO: if this temporary solution stays, we need here a way to use authDummy somehow in developpement
Nothing -> permissionDenied "no trusted header found !"
Just name -> do
mUser <- runDB $ getBy $ UniqueName (decodeUtf8 name)
case mUser of
Nothing -> runDB $ insert $ User (decodeUtf8 name)
Just u -> return $ entityKey u
mUser <- case mName of
-- TODO: make remote user an argument to make it usable not only with authelia, and maybe do a check for good mesure when nothing is found ?
Just name -> runDB $ insertBy $ User (decodeUtf8 name)
Nothing -> runDB $ insertBy $ User "single-user"
case mUser of
Left (Entity userId _) -> return userId
Right userId -> return userId
dbIfAuth :: GroupId -> ReaderT SqlBackend (HandlerFor App) b -> HandlerFor App b
dbIfAuth groupId action = do
-- TODO: decide if we prefer fast (rawSql) or safe (type safe persist query) after in production latency tests
-- TODO: optimize the persist implementation anyway