89 lines
No EOL
3.5 KiB
Haskell
89 lines
No EOL
3.5 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_
|
|
_ <- dbIfAuth groupId (insertUnique $ Todolist groupId list)
|
|
redirect $ TodolistR groupId
|
|
|
|
-- TODO: move this to a new handler file
|
|
getTodolistR :: GroupId -> Handler Html
|
|
getTodolistR groupId = do
|
|
lists <- dbIfAuth groupId (selectList [TodolistGroupId ==. groupId] [])
|
|
mToken <- fmap reqToken getRequest
|
|
defaultLayout $ do
|
|
let getTitle = todolistTitle . entityVal
|
|
setTitle "todolist"
|
|
[whamlet|
|
|
<a href=@{GroupR}>Home
|
|
<ul>
|
|
$forall list <- lists
|
|
<li>
|
|
<a href=@{TodolistItemsR groupId (entityKey list)}>#{getTitle list}
|
|
<form action=@{AddTodolistR groupId} method="post">
|
|
<input type="text" name="list" placeholder="new list">
|
|
$maybe token <- mToken
|
|
<input type="hidden" name="_token" value="#{token}">
|
|
<button type="submit">add
|
|
<form action=@{AddUserR groupId} method="post">
|
|
<input type="text" name="user" placeholder="new user">
|
|
$maybe token <- mToken
|
|
<input type="hidden" name="_token" value="#{token}">
|
|
<button type="submit">share
|
|
<a href=@{EditTodolistR groupId}>Edit
|
|
|]
|
|
|
|
getEditTodolistR :: GroupId -> Handler Html
|
|
getEditTodolistR groupId = do
|
|
lists <- runDB $
|
|
selectList [TodolistGroupId ==. groupId] [Asc TodolistTitle]
|
|
mToken <- fmap reqToken getRequest
|
|
defaultLayout $ do
|
|
let keyToText e = pack $ show $ fromSqlKey $ entityKey e ::Text
|
|
setTitle "Groups"
|
|
[whamlet|
|
|
<form action=@{DeleteTodolistR groupId} method="POST">
|
|
<ul>
|
|
$forall list <- lists
|
|
<li>
|
|
<input type="checkbox" name="ids" value="#{keyToText list}">
|
|
<a href="">#{(todolistTitle . entityVal) list}
|
|
$maybe token <- mToken
|
|
<input type="hidden" name="_token" value="#{token}">
|
|
<button type=submit>Delete selected
|
|
<a href=@{TodolistR groupId}>Back
|
|
|]
|
|
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 |