127 lines
No EOL
5.7 KiB
Haskell
127 lines
No EOL
5.7 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.TodolistItem where
|
|
|
|
import Import
|
|
import Database.Persist.Sql (rawExecute)
|
|
|
|
getTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
|
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])
|
|
|
|
mToken <- fmap reqToken getRequest
|
|
defaultLayout $ do
|
|
setTitle "items"
|
|
[whamlet|
|
|
<a href=@{GroupR}>Home
|
|
|
|
<a href=@{TodolistR groupId}>Lists
|
|
<ul>
|
|
$forall item <- items
|
|
<li>
|
|
<form action=@{CheckTodolistItemR groupId todolistId (entityKey item)} method="POST">
|
|
$maybe token <- mToken
|
|
<input type="hidden" name="_token" value="#{token}">
|
|
<button type="submit">#{getText item}
|
|
<form action=@{AddTodolistItemR groupId todolistId} method="post">
|
|
<form action=@{AddTodolistItemR groupId todolistId} method="post">
|
|
<input type="text" name="item" placeholder="new item">
|
|
$maybe token <- mToken
|
|
<input type="hidden" name="_token" value="#{token}">
|
|
<button type="submit">add
|
|
<form action=@{TrimTodolistItemsR groupId todolistId} method="post">
|
|
$maybe token <- mToken
|
|
<input type="hidden" name="_token" value="#{token}">
|
|
<button type="submit">trim
|
|
<form action=@{SortTodolistItemsR groupId todolistId} method="post">
|
|
$maybe token <- mToken
|
|
<input type="hidden" name="_token" value="#{token}">
|
|
<button type="submit">sort
|
|
<a href=@{EditTodolistItemsR groupId todolistId}>Edit
|
|
|]
|
|
|
|
|
|
postCheckTodolistItemR :: GroupId -> TodolistId -> TodolistItemId -> Handler Html
|
|
postCheckTodolistItemR groupId todolistId todolistItemId = do
|
|
dbIfAuth groupId (rawExecute "UPDATE todolist_item SET value = NOT value WHERE id = ?" [toPersistValue todolistItemId])
|
|
redirect $ TodolistItemsR groupId todolistId
|
|
|
|
|
|
postAddTodolistItemR :: GroupId -> TodolistId -> Handler Html
|
|
postAddTodolistItemR groupId todolistId = do
|
|
item <- runInputPost $ ireq textField "item"
|
|
_ <- dbIfAuth groupId (insert_ $ TodolistItem todolistId False item)
|
|
redirect $ TodolistItemsR groupId todolistId
|
|
|
|
getEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
|
getEditTodolistItemsR groupId todolistId = do
|
|
items <- dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [])
|
|
mToken <- fmap reqToken getRequest
|
|
let text = unlines $ map getText items
|
|
defaultLayout $ do
|
|
setTitle "edit"
|
|
[whamlet|
|
|
<form action=@{EditTodolistItemsR groupId todolistId} method=POST>
|
|
<label for="edit text area">Edit todolist
|
|
<br>
|
|
<textarea id="edit text area" name=text rows=30 cols=50 placeholder="[x] wake up1 [x] eat [ ] sleep [ ] repeat">#{text}
|
|
$maybe token <- mToken
|
|
<input type="hidden" name="_token" value="#{token}">
|
|
<br>
|
|
<button type="submit">edit
|
|
|]
|
|
postEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
|
postEditTodolistItemsR groupId todolistId = do
|
|
mText <- runInputPost $ iopt textField "text"
|
|
let xs = case mText of
|
|
(Just text) -> getItems text todolistId
|
|
Nothing -> []
|
|
dbIfAuth groupId (do
|
|
deleteWhere [TodolistItemTodolistId ==. todolistId]
|
|
insertMany_ xs)
|
|
|
|
redirect $ TodolistItemsR groupId todolistId
|
|
|
|
getText :: Entity TodolistItem -> Text
|
|
getText item =
|
|
if value then "[x] " <> name
|
|
else "[ ] " <> name
|
|
where
|
|
value = (todolistItemValue . entityVal) item
|
|
name = (todolistItemName . entityVal) item
|
|
|
|
getItems :: Text -> TodolistId -> [TodolistItem]
|
|
getItems text todolistId = map read (lines text)
|
|
where read line = do
|
|
let (d, n) = splitAt 4 line
|
|
let
|
|
value = case d of
|
|
"[x] " -> True
|
|
"[ ] " -> False
|
|
_ -> error "Invalid status"
|
|
name = case n of
|
|
"" -> error "empty name"
|
|
something -> filter (/= '\r') something
|
|
TodolistItem todolistId value name
|
|
|
|
postTrimTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
|
postTrimTodolistItemsR groupId todolistId = do
|
|
dbIfAuth groupId (deleteWhere [TodolistItemTodolistId ==. todolistId, TodolistItemValue ==. True])
|
|
redirect $ TodolistItemsR groupId todolistId
|
|
postSortTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
|
postSortTodolistItemsR groupId todolistId = do
|
|
mSession <- lookupSession "sort"
|
|
case mSession of
|
|
(Just "value") -> setSession "sort" "id"
|
|
_ -> setSession "sort" "value"
|
|
redirect $ TodolistItemsR groupId todolistId |