From 16bcee802d3c6dc2c47432acb56fd214e9c23959 Mon Sep 17 00:00:00 2001 From: Stuce Date: Mon, 14 Jul 2025 22:07:57 +0200 Subject: [PATCH] added some text capabilities --- src/Foundation.hs | 22 ++++++++++++++++++++++ src/Handler/Api.hs | 34 +--------------------------------- src/Handler/Group.hs | 17 +++++++++++------ src/Handler/Todolist.hs | 14 +++++++++----- src/Handler/TodolistItem.hs | 12 ++++++++---- 5 files changed, 51 insertions(+), 48 deletions(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index 98ad0e6..80b5326 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -13,11 +13,13 @@ module Foundation where import Control.Monad.Logger (LogSource) import Data.Kind (Type) +import Data.Text qualified as Text (intercalate, pack) import Database.Persist.Sql (ConnectionPool, rawSql, runSqlPool) import Import.NoFoundation import Text.Hamlet (hamletFile) import Text.Jasmine (minifym) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Yesod.Core.Types (Logger) import Yesod.Core.Unsafe qualified as Unsafe import Yesod.Default.Util (addStaticContentExternal) @@ -225,3 +227,23 @@ getGroups :: Key User -> Handler [Entity Group] getGroups userId = let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?" 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" diff --git a/src/Handler/Api.hs b/src/Handler/Api.hs index c1be3d8..912575c 100644 --- a/src/Handler/Api.hs +++ b/src/Handler/Api.hs @@ -4,8 +4,7 @@ module Handler.Api where -import Data.Text qualified as Text -import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Database.Persist.Sql (rawSql) import Import @@ -32,34 +31,3 @@ getApiR time = do <> map todolistToCSV lists <> map todolistItemToCSV items 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" diff --git a/src/Handler/Group.hs b/src/Handler/Group.hs index 6c76734..5219c0e 100644 --- a/src/Handler/Group.hs +++ b/src/Handler/Group.hs @@ -13,14 +13,19 @@ import Database.Persist.Sql (fromSqlKey, toSqlKey) import Import import Text.Read -getGroupR :: Handler Html +getGroupR :: Handler TypedContent getGroupR = do userId <- getUserId groups <- getGroups userId - defaultLayout $ do - setTitle "Groups" - $(widgetFile "group") -postAddGroupR :: Handler Html + selectRep $ do + provideRep + $ defaultLayout + $ do + setTitle "Groups" + $(widgetFile "group") + provideRep $ return $ unlines $ map groupToCSV groups + +postAddGroupR :: Handler TypedContent postAddGroupR = do g <- runInputPost $ ireq textField "group" -- TODO: in a newer version, put insertUnique_ @@ -40,7 +45,7 @@ getEditGroupR = do let a e = pack $ show $ fromSqlKey $ entityKey e :: Text setTitle "Groups" $(widgetFile "edit-group") -postEditGroupR :: Handler Html +postEditGroupR :: Handler TypedContent postEditGroupR = do -- TODO: not implemented yet -- title <- runInputPost $ ireq textField "title" diff --git a/src/Handler/Todolist.hs b/src/Handler/Todolist.hs index c145309..b45376f 100644 --- a/src/Handler/Todolist.hs +++ b/src/Handler/Todolist.hs @@ -22,13 +22,17 @@ postAddTodolistR groupId = do _ <- dbIfAuth groupId (insertUnique $ Todolist groupId list currentTime) redirect $ TodolistR groupId -getTodolistR :: GroupId -> Handler Html +getTodolistR :: GroupId -> Handler TypedContent getTodolistR groupId = do lists <- dbIfAuth groupId (selectList [TodolistGroupId ==. groupId] []) - defaultLayout $ do - let getTitle = todolistTitle . entityVal - setTitle "todolist" - $(widgetFile "todolist") + selectRep $ do + provideRep + $ defaultLayout + $ do + let getTitle = todolistTitle . entityVal + setTitle "todolist" + $(widgetFile "todolist") + provideRep $ return $ unlines $ map todolistToCSV lists getEditTodolistR :: GroupId -> Handler Html getEditTodolistR groupId = do diff --git a/src/Handler/TodolistItem.hs b/src/Handler/TodolistItem.hs index 4dc8f7a..707822f 100644 --- a/src/Handler/TodolistItem.hs +++ b/src/Handler/TodolistItem.hs @@ -13,16 +13,20 @@ module Handler.TodolistItem where import Database.Persist.Sql (rawExecute) import Import -getTodolistItemsR :: GroupId -> TodolistId -> Handler Html +getTodolistItemsR :: GroupId -> TodolistId -> Handler TypedContent getTodolistItemsR groupId todolistId = do 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]) - defaultLayout $ do - setTitle "items" - $(widgetFile "todolist-items") + selectRep $ do + provideRep + $ defaultLayout + $ do + setTitle "items" + $(widgetFile "todolist-items") + provideRep $ return $ unlines $ map todolistItemToCSV items postCheckTodolistItemR :: GroupId -> TodolistId -> TodolistItemId -> Handler Html postCheckTodolistItemR groupId todolistId todolistItemId = do