added some text capabilities

This commit is contained in:
Stuce 2025-07-14 22:07:57 +02:00
parent 2ce5997c93
commit 16bcee802d
5 changed files with 51 additions and 48 deletions

View file

@ -13,11 +13,13 @@ module Foundation where
import Control.Monad.Logger (LogSource) import Control.Monad.Logger (LogSource)
import Data.Kind (Type) import Data.Kind (Type)
import Data.Text qualified as Text (intercalate, pack)
import Database.Persist.Sql (ConnectionPool, rawSql, runSqlPool) import Database.Persist.Sql (ConnectionPool, rawSql, runSqlPool)
import Import.NoFoundation import Import.NoFoundation
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Yesod.Core.Types (Logger) import Yesod.Core.Types (Logger)
import Yesod.Core.Unsafe qualified as Unsafe import Yesod.Core.Unsafe qualified as Unsafe
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
@ -225,3 +227,23 @@ getGroups :: Key User -> Handler [Entity Group]
getGroups userId = getGroups userId =
let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?" let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?"
in runDB $ rawSql sql [toPersistValue userId] in runDB $ rawSql sql [toPersistValue userId]
todolistItemToCSV :: Entity TodolistItem -> Text
todolistItemToCSV item = "i," <> fieldToText item
todolistToCSV :: Entity Todolist -> Text
todolistToCSV list = "l," <> fieldToText list
groupToCSV :: Entity Group -> Text
groupToCSV group = "g," <> fieldToText group
userToCSV :: Entity User -> Text
userToCSV user = "u," <> fieldToText user
-- TODO: error management ? (maybe use Either Text Text and then propagate left to handler and send error ?)
fieldToText :: (PersistEntity record) => Entity record -> Text
fieldToText field = Text.intercalate "," (map persistValueToText $ entityValues field)
persistValueToText :: PersistValue -> Text
persistValueToText (PersistText s) = s
persistValueToText (PersistInt64 i) = Text.pack $ show i
persistValueToText (PersistUTCTime d) = Text.pack $ show $ floor (utcTimeToPOSIXSeconds d)
persistValueToText (PersistBool b) = if b then "T" else "F"
persistValueToText _ = error "Wrong input type"

View file

@ -4,8 +4,7 @@
module Handler.Api where module Handler.Api where
import Data.Text qualified as Text import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import Database.Persist.Sql (rawSql) import Database.Persist.Sql (rawSql)
import Import import Import
@ -32,34 +31,3 @@ getApiR time = do
<> map todolistToCSV lists <> map todolistToCSV lists
<> map todolistItemToCSV items <> map todolistItemToCSV items
return $ TypedContent typePlain $ toContent t return $ TypedContent typePlain $ toContent t
todolistItemToCSV :: Entity TodolistItem -> Text
todolistItemToCSV item = "i," <> fieldToText item
todolistToCSV :: Entity Todolist -> Text
todolistToCSV list = "l," <> fieldToText list
groupToCSV :: Entity Group -> Text
groupToCSV group = "g," <> fieldToText group
userToCSV :: Entity User -> Text
userToCSV user = "u," <> fieldToText user
-- TODO: error management ? (maybe use Either Text Text and then propagate left to handler and send error ?)
fieldToText :: (PersistEntity record) => Entity record -> Text
fieldToText field = Text.intercalate "," (map persistValueToText $ entityValues field)
persistValueToText :: PersistValue -> Text
persistValueToText (PersistText s) = s
persistValueToText (PersistInt64 i) = Text.pack $ show i
persistValueToText (PersistUTCTime d) = Text.pack $ show $ floor (utcTimeToPOSIXSeconds d)
persistValueToText (PersistBool b) = if b then "T" else "F"
persistValueToText _ = error "Wrong input type"
getText :: Text
getText = do
-- GET EVERY GROUP THAT HAS BEEN MODIFIED SINCE TIMESTAMP FROM USER
-- GET EVERY TODOLIST THAT HAS BEEN MODIFIED SINCE TIMESTAMP
-- GET EVERY ITEM FROM THESE TODOLISTS
-- ENCODE ALL OF THEM IN THE TEXTFILE
-- SEND IT !
-- DONE :)
error "not done yet"

View file

@ -13,14 +13,19 @@ import Database.Persist.Sql (fromSqlKey, toSqlKey)
import Import import Import
import Text.Read import Text.Read
getGroupR :: Handler Html getGroupR :: Handler TypedContent
getGroupR = do getGroupR = do
userId <- getUserId userId <- getUserId
groups <- getGroups userId groups <- getGroups userId
defaultLayout $ do selectRep $ do
provideRep
$ defaultLayout
$ do
setTitle "Groups" setTitle "Groups"
$(widgetFile "group") $(widgetFile "group")
postAddGroupR :: Handler Html provideRep $ return $ unlines $ map groupToCSV groups
postAddGroupR :: Handler TypedContent
postAddGroupR = do postAddGroupR = do
g <- runInputPost $ ireq textField "group" g <- runInputPost $ ireq textField "group"
-- TODO: in a newer version, put insertUnique_ -- TODO: in a newer version, put insertUnique_
@ -40,7 +45,7 @@ getEditGroupR = do
let a e = pack $ show $ fromSqlKey $ entityKey e :: Text let a e = pack $ show $ fromSqlKey $ entityKey e :: Text
setTitle "Groups" setTitle "Groups"
$(widgetFile "edit-group") $(widgetFile "edit-group")
postEditGroupR :: Handler Html postEditGroupR :: Handler TypedContent
postEditGroupR = do postEditGroupR = do
-- TODO: not implemented yet -- TODO: not implemented yet
-- title <- runInputPost $ ireq textField "title" -- title <- runInputPost $ ireq textField "title"

View file

@ -22,13 +22,17 @@ postAddTodolistR groupId = do
_ <- dbIfAuth groupId (insertUnique $ Todolist groupId list currentTime) _ <- dbIfAuth groupId (insertUnique $ Todolist groupId list currentTime)
redirect $ TodolistR groupId redirect $ TodolistR groupId
getTodolistR :: GroupId -> Handler Html getTodolistR :: GroupId -> Handler TypedContent
getTodolistR groupId = do getTodolistR groupId = do
lists <- dbIfAuth groupId (selectList [TodolistGroupId ==. groupId] []) lists <- dbIfAuth groupId (selectList [TodolistGroupId ==. groupId] [])
defaultLayout $ do selectRep $ do
provideRep
$ defaultLayout
$ do
let getTitle = todolistTitle . entityVal let getTitle = todolistTitle . entityVal
setTitle "todolist" setTitle "todolist"
$(widgetFile "todolist") $(widgetFile "todolist")
provideRep $ return $ unlines $ map todolistToCSV lists
getEditTodolistR :: GroupId -> Handler Html getEditTodolistR :: GroupId -> Handler Html
getEditTodolistR groupId = do getEditTodolistR groupId = do

View file

@ -13,16 +13,20 @@ module Handler.TodolistItem where
import Database.Persist.Sql (rawExecute) import Database.Persist.Sql (rawExecute)
import Import import Import
getTodolistItemsR :: GroupId -> TodolistId -> Handler Html getTodolistItemsR :: GroupId -> TodolistId -> Handler TypedContent
getTodolistItemsR groupId todolistId = do getTodolistItemsR groupId todolistId = do
mSortOption <- lookupSession "sort" mSortOption <- lookupSession "sort"
items <- case mSortOption of items <- case mSortOption of
(Just "value") -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Desc TodolistItemValue, Asc TodolistItemId]) (Just "value") -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Desc TodolistItemValue, Asc TodolistItemId])
_ -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Asc TodolistItemId]) _ -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Asc TodolistItemId])
defaultLayout $ do selectRep $ do
provideRep
$ defaultLayout
$ do
setTitle "items" setTitle "items"
$(widgetFile "todolist-items") $(widgetFile "todolist-items")
provideRep $ return $ unlines $ map todolistItemToCSV items
postCheckTodolistItemR :: GroupId -> TodolistId -> TodolistItemId -> Handler Html postCheckTodolistItemR :: GroupId -> TodolistId -> TodolistItemId -> Handler Html
postCheckTodolistItemR groupId todolistId todolistItemId = do postCheckTodolistItemR groupId todolistId todolistItemId = do