46 行
1.3 KiB
Haskell
46 行
1.3 KiB
Haskell
module Main (main) where
|
|
|
|
import Lib
|
|
import Database.SQLite.Simple
|
|
|
|
import Control.Monad (msum)
|
|
import qualified Data.Text as T
|
|
import Control.Monad.Trans (lift)
|
|
|
|
|
|
import Happstack.Server
|
|
( Response, ServerPart, ServerPartT, Method (POST, GET), Conf(..), nullConf
|
|
, decodeBody, defaultBodyPolicy, lookText', lookTexts', looks, lookRead
|
|
, dir, dirs, nullConf, simpleHTTP, lookFile, nullDir, path
|
|
, toResponse, methodM, ok, badRequest, seeOther, notFound
|
|
, Browsing(..), serveDirectory, ctSubtype, ContentType(..)
|
|
)
|
|
|
|
main :: IO ()
|
|
main = simpleHTTP nullConf $
|
|
do decodeBody (defaultBodyPolicy "/tmp/" 1024 1024 1024)
|
|
msum [ mainPageForm
|
|
, dir "save-change" saveChangeForm
|
|
, dir "add-item" addItemForm ]
|
|
|
|
mainPageForm :: ServerPart Response
|
|
mainPageForm = do
|
|
nullDir
|
|
items <- lift $ getItems 20
|
|
return $ toResponse $ mainPage items
|
|
|
|
addItemForm :: ServerPart Response
|
|
addItemForm =
|
|
do methodM POST
|
|
title <- lookText' "title"
|
|
description <- lookText' "description"
|
|
lift $ addItem title description
|
|
seeOther ("/" :: String) $ toResponse ("Done" :: String)
|
|
|
|
saveChangeForm :: ServerPart Response
|
|
saveChangeForm =
|
|
do methodM POST
|
|
ids <- looks "done"
|
|
lift $ setCompletion $ (map read ids :: [Int])
|
|
seeOther ("/" :: String) $ toResponse ("Done" :: String)
|