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 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"
|
||||||
|
|
|
||||||
|
|
@ -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"
|
|
||||||
|
|
|
||||||
|
|
@ -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"
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue