91 lines
No EOL
3.8 KiB
Haskell
91 lines
No EOL
3.8 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])
|
|
|
|
defaultLayout $ do
|
|
setTitle "items"
|
|
$(widgetFile "todolist-items")
|
|
|
|
|
|
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] [])
|
|
let text = unlines $ map getText items
|
|
defaultLayout $ do
|
|
setTitle "edit"
|
|
$(widgetFile "edit-todolist-items")
|
|
|
|
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 |