added some text capabilities
This commit is contained in:
parent
2ce5997c93
commit
16bcee802d
5 changed files with 51 additions and 48 deletions
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
selectRep $ do
|
||||
provideRep
|
||||
$ defaultLayout
|
||||
$ do
|
||||
setTitle "Groups"
|
||||
$(widgetFile "group")
|
||||
postAddGroupR :: Handler Html
|
||||
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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue