61 lines
No EOL
2.2 KiB
Haskell
61 lines
No EOL
2.2 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
|
{-# HLINT ignore "Replace case with fromMaybe" #-}
|
|
module Handler.Todolist where
|
|
|
|
import Import
|
|
import Text.Read
|
|
import Database.Persist.Sql (fromSqlKey, toSqlKey)
|
|
postAddTodolistR :: GroupId -> Handler Html
|
|
postAddTodolistR groupId = do
|
|
list <- runInputPost $ ireq textField "list"
|
|
-- TODO: in a newer version, put insertUnique_
|
|
currentTime <- liftIO getCurrentTime
|
|
_ <- dbIfAuth groupId (insertUnique $ Todolist groupId list currentTime)
|
|
redirect $ TodolistR groupId
|
|
|
|
-- TODO: move this to a new handler file
|
|
getTodolistR :: GroupId -> Handler Html
|
|
getTodolistR groupId = do
|
|
lists <- dbIfAuth groupId (selectList [TodolistGroupId ==. groupId] [])
|
|
defaultLayout $ do
|
|
let getTitle = todolistTitle . entityVal
|
|
setTitle "todolist"
|
|
$(widgetFile "todolist")
|
|
|
|
getEditTodolistR :: GroupId -> Handler Html
|
|
getEditTodolistR groupId = do
|
|
lists <- runDB $
|
|
selectList [TodolistGroupId ==. groupId] [Asc TodolistTitle]
|
|
defaultLayout $ do
|
|
let keyToText e = pack $ show $ fromSqlKey $ entityKey e ::Text
|
|
setTitle "Groups"
|
|
$(widgetFile "edit-todolist")
|
|
|
|
postDeleteTodolistR :: GroupId -> Handler Html
|
|
postDeleteTodolistR groupId = do
|
|
text <- lookupPostParams "ids"
|
|
let ints = map (read . unpack) text :: [Int64]
|
|
let ids = map toSqlKey ints :: [TodolistId]
|
|
dbIfAuth groupId (deleteWhere [TodolistId <-. ids])
|
|
redirect $ EditTodolistR groupId
|
|
postEditTodolistR :: GroupId -> Handler Html
|
|
postEditTodolistR groupId = error "not done yet"
|
|
|
|
postAddUserR :: GroupId -> Handler Html
|
|
postAddUserR groupId= do
|
|
user <- runInputPost $ ireq textField "user"
|
|
_ <- dbIfAuth groupId (do
|
|
mUserId <- getBy $ UniqueName user
|
|
case mUserId of
|
|
Nothing -> --handle error
|
|
redirect $ TodolistR groupId
|
|
Just userId -> insert $ GroupUser (entityKey userId) groupId
|
|
)
|
|
redirect $ TodolistR groupId |