108 行
3.5 KiB
Haskell
108 行
3.5 KiB
Haskell
module Lib
|
|
( mainPage
|
|
, TodoItem(..)
|
|
, addItem
|
|
, getItems
|
|
, setCompletion
|
|
) where
|
|
|
|
import Text.Blaze ((!))
|
|
import qualified Text.Blaze.Html5 as H
|
|
import qualified Text.Blaze.Html5.Attributes as A
|
|
|
|
import qualified Data.Text as T
|
|
import Data.Time
|
|
|
|
import Database.SQLite.Simple
|
|
import Database.SQLite.Simple.FromRow
|
|
|
|
mainPage :: [TodoItem] -> H.Html
|
|
mainPage items =
|
|
H.docTypeHtml $ do
|
|
H.head $ do
|
|
H.title "TODO list"
|
|
H.meta ! A.httpEquiv "Cache-Control"
|
|
! A.content "no-store"
|
|
H.body $ do
|
|
H.h1 "TODO list"
|
|
H.form ! A.id "save-change" ! A.method "POST" ! A.action "save-change" $ do
|
|
H.table $ do
|
|
foldl (<>) tableHeader $ map makeItemRow items
|
|
H.input ! A.type_ "submit"
|
|
! A.value "save"
|
|
H.form ! A.id "add-item" ! A.method "POST" ! A.action "add-item" $ do
|
|
H.p $ H.b "Add item:"
|
|
H.span $ do
|
|
H.p "title"
|
|
H.input ! A.type_ "text"
|
|
! A.name "title"
|
|
H.span $ do
|
|
H.p "description"
|
|
H.input ! A.type_ "text"
|
|
! A.name "description"
|
|
H.br
|
|
H.input ! A.type_ "submit"
|
|
! A.value "submit"
|
|
|
|
|
|
tableHeader :: H.Html
|
|
tableHeader =
|
|
H.tr $ do
|
|
H.td "done"
|
|
H.td "title"
|
|
H.td "description"
|
|
H.td "add date"
|
|
|
|
makeItemRow :: TodoItem -> H.Html
|
|
makeItemRow item =
|
|
H.tr $ do
|
|
H.td $ do
|
|
if getItemCompleted item
|
|
then H.input ! A.type_ "checkbox"
|
|
! A.name "done"
|
|
! A.value (H.toValue $ getItemId item)
|
|
! A.checked "true"
|
|
else H.input ! A.type_ "checkbox"
|
|
! A.name "done"
|
|
! A.value ( H.toValue $ getItemId item)
|
|
H.td $ H.toHtml $ getItemTitle item
|
|
H.td $ H.toHtml $ getItemDescription item
|
|
H.td $ H.toHtml $ formatTime defaultTimeLocale "%D %T" $ getItemAddDate item
|
|
|
|
data TodoItem = TodoItem { getItemId :: Int
|
|
, getItemCompleted :: Bool
|
|
, getItemTitle :: T.Text
|
|
, getItemDescription :: T.Text
|
|
, getItemAddDate :: UTCTime
|
|
, getItemCompletionDate :: Maybe UTCTime }
|
|
|
|
instance FromRow TodoItem where
|
|
fromRow = TodoItem <$> field
|
|
<*> field
|
|
<*> field
|
|
<*> field
|
|
<*> field
|
|
<*> field
|
|
|
|
addItem :: T.Text -> T.Text -> IO ()
|
|
addItem title description = do
|
|
conn <- open "todo.db"
|
|
date <- getCurrentTime
|
|
let format_date = formatTime defaultTimeLocale "%FT%T" date
|
|
execute conn "INSERT INTO items (completed, title, description, add_date) VALUES (?, ?, ?, ?)" (False, title, description, format_date)
|
|
close conn
|
|
|
|
getItems :: Int -> IO [TodoItem]
|
|
getItems limit = do
|
|
conn <- open "todo.db"
|
|
items <- query conn "SELECT * FROM items LIMIT (?)" (Only limit) :: IO [TodoItem]
|
|
close conn
|
|
return items
|
|
|
|
setCompletion :: [Int] -> IO ()
|
|
setCompletion items_id = do
|
|
conn <- open "todo.db"
|
|
execute conn "UPDATE items SET completed = 0" ()
|
|
mapM_ (\item -> execute conn "UPDATE items SET completed = 1 WHERE id = ?" (Only item)) items_id
|
|
close conn
|