Happstack: část třetí

Zpracování formulářů v Happstacku probíhá podobně jako u jiných frameworků. Server vygeneruje HTML kód formuláře, uživatel formulář vyplní a odešle, aplikace zadané hodnoty ověří a pokud je všechno v pořádku, zpracuje je. V opačném případě je formulář vygenerován znovu a uživatel je požádán o opravu nevyhovujících položek. Napíšeme si jednoduchou návštěvní knihu, což je webová aplikace využívající právě takovýto formulář.

Definice URL

Aplikaci budeme provozovat na adrese http://localhost:8000/navstevni-kniha/. Kořenovému URL http://localhost:8000/ nastavíme přesměrování na adresu návštěvní knihy. Začátek naší aplikace by mohl vypadat kupříkladu takto:

{-# OPTIONS -fglasgow-exts #-}
{-# LANGUAGE TemplateHaskell #-}

module Main where

import Text.Html
import Data.Time
import Data.Generics
import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import Control.Concurrent
import Happstack.Data
import Happstack.State
import Happstack.Server
import Happstack.Helpers

url :: String
url = "navstevni-kniha"

handleURL :: ServerPart Response
handleURL = msum [ nullDir >> (movedPermanently (url ++ "/") (toResponse ""))
                 , methodOnly GET >> (dir url $ showMessages [])
                 , methodOnly POST >> (dir url addMessage)
                 , notFound $ toResponse "Chyba 404"
                 ]

První řádek aktivuje obecná rozšíření Haskellu, druhý zapne rozšíření TemplateHaskell, které použijeme v poslední části tohoto článku. Dále načítáme několik nezbytných modulů a definujeme si strukturu odkazů.

Zda-li je formulář odeslán nebo ne, zjistíme pomocí použitých HTTP metod. Formulář se bude odesílat metodou POST, ostatní dotazy budou využívat metodu GET. Jak jsme si ukázali minule, pomocí funkce methodOnly si můžeme v definici URL jednoduše určit, jakou HTTP metodu budeme v kódu požadovat a oddělit tak obě možnosti. Klíčové jsou funkce showMessages a addMessage, které si později napíšeme a které budou vykonávat hlavní funkcionalitu. První zobrazí formulář návštěvní knihy spolu s příspěvky (její argument znázorňuje chybové hlášky u formuláře), druhá zpracuje odeslaná data přes formulář.

Generování HTML

Pro vygenerování HTML kódu použijeme kombinátory. Samozřejmě by nebyl žádný problém využít šablony či psát HTML kód přímo. Začneme pomocnými funkcemi generujícími HTML kód:

messageForm :: [String] -> Html
messageForm errors = (toHtmlFromList $ map (p <<) errors) +++ form ! [action ".", Text.Html.method "post"]
    << simpleTable [] [] [ [thediv << "Jméno", input ! [name "nick"]]
                         , [thediv << "Text", textarea ! [name "entry"] << noHtml]
                         , [noHtml, input ! [thetype "submit", value "Přidat"]]]

messageItem :: Message -> Html
messageItem m = hr +++ thediv << (nick m ++ " " ++ added m) +++ thediv << entry m

page :: Html -> Html
page code = header << thetitle << "Návštěvní kniha" +++ body << (h1 << "Návštěvní kniha" +++ code)

Funkce messageForm vygeneruje formulář spolu s případnými chybovými hláškami, funkce messageItem příspěvek v návštěvní knize a funkce page základní kostru stránky. Knihovna Text.Html bohužel neumí HTML značku <label>, kterou bych normálně ve formuláři použil, ale v případě nutnosti by nebyl problém si odpovídající kombinátor doplnit. Funkce simpleTable vygeneruje HTML tabulku ze seznamu seznamů. Následuje definice funkce na zobrazování stránek:

showMessages :: [String] -> ServerPart Response
showMessages errors = query LoadMessages >>= \ms -> ok . toResponse . page $ messageForm errors +++ (toHtmlFromList $ map messageItem ms)

Zavoláním funkce query se načtou data z úložiště (viz dále), která se předají dále a vypíšou spolu s formulářem. Příspěvky jsou uloženy v seznamu, takže stačí namapovat na každý prvek tohoto seznamu výše definovanou funkci pro generování HTML. Funkce pro zpracovávání formuláře je složitější:

errorNick :: String
errorNick = "Musíte uvést své jméno."

errorEntry :: String
errorEntry = "Je nutné vyplnit text příspěvku."

addMessage :: ServerPart Response
addMessage = do
    Just nick <- getDataFn $ look "nick"
    Just entry <- getDataFn $ look "entry"
    case (nick, entry) of
        ("", "") -> showMessages [errorNick, errorEntry]
        ("",  _) -> showMessages [errorNick]
        (_,  "") -> showMessages [errorEntry]
        (n,   e) -> do t <- liftIO getCurrentTime
                       update $ SaveMessage (Message {added=show t, nick=n, entry=e})
                       found "." (toResponse "")

První dvě definice jsou jenom chybové hlášky, které vypíšeme při vynechání jednoho ze dvou políček formuláře. Zavoláním funkce getDataFn přistoupíme k odeslaným datům z formuláře, která jsou typu Maybe. Poté se na základě vstupu rozhodneme, zda vypsat nějakou z chybových hlášek, či zjistit aktuální čas (funkce getCurrentTime), přidat novou položku úložiště, obsahující hodnoty z formuláře a čas v textové podobě, a přesměrovat s HTTP kódem 302 zpět na stránku s návštěvní knihou.

Úložiště dat MACID

Haskell samozřejmě podporuje relační databáze, například přes vynikající rozhraní HDBC, my si však vyzkoušíme takzvaný systém MACID (též označováno jako ACID monad), jenž se nachází v modulu Happstack.State. Jak název napovídá, samotný systém má k databázím blízko. Písmeno M v názvu značí monády, zkratka ACID (atomicity, consistency, isolation, durability) se používá ve spojení s databázovými transakcemi. Základem tohoto ukládacího systému je stavová monáda zajišťující správu dat. Na MACID můžeme nahlížet jako na funkcionální datové úložiště vytvořené přímo pro webové aplikace.

Toto úložiště nepoužívá datové schéma v klasickém databázovém pojetí, akceptuje téměř libovolnou datovou strukturu, kterou mu pošleme. Nejprve si musíme tedy takovou strukturu definovat. Bude obsahovat čas odeslání, jméno pisatele a text příspěvku:

data Message = Message { added :: String
                       , nick :: String
                       , entry :: String
                       } deriving (Typeable, Data)

newtype Messages = Messages [Message] deriving (Typeable, Data)

Datová struktura Message představuje jednu zprávu, typ Messages seznam takových zpráv. Aktuální čas nám bude zajišťovat modul Data.Time, pro zjednodušení ho budeme ukládat jako řetězec. Na to, aby ukládání fungovalo, je třeba kromě odvození tříd Typeable a Data si nechat vygenerovat pomocí TemplateHaskellu instance tříd Version a Component:

instance Version Message
$(deriveSerialize ''Message)

instance Version Messages
$(deriveSerialize ''Messages)

instance Component Messages where
    type Dependencies Messages = End
    initialValue = Messages []

Vypadá to jako těžká magie, ale první dvě definice pouze vytvoří výchozí kód pro instanci a v té třetí jsme stanovili, že náš typ Messages nezávisí na ostatních součástech a že jeho počáteční hodnota je prázdný seznam. Ještě musíme napsat definice funkcí na ukládání příspěvku a na jejich vybírání z úložiště:

saveMessage :: (MonadState Messages m) => Message -> m ()
saveMessage m = modify (\(Messages ms) -> Messages (m:ms))

loadMessages :: (MonadReader Messages m) => m [Message]
loadMessages = asks (\(Messages ms) -> ms)

Tohle se jeví o trochu čitelnější. Funkce saveMessage uloží do stavové monády příspěvek, funkce loadMessages vybere celý seznam příspěvků. Jsou zde použity funkce modify a asks z modulů Control.Monad.State a Control.Monad.Reader. Namísto anonymních funkcí by bylo zřejmě lepší použít aplikativní funktory (modul Control.Applicative), ale museli bychom si odvodit či napsat jejich instance. Teď už zbývá jenom naše dvě funkce registrovat přes TemplateHaskell, což nám vygeneruje metody pro zacházení se stavovou monádou, a dopsat hlavní funkci:

$(mkMethods ''Messages ['saveMessage, 'loadMessages])

main :: IO ()
main = do
    system <- startSystemState (Proxy :: Proxy Messages)
    tid <- forkIO $ simpleHTTP nullConf handleURL
    waitForTermination
    killThread tid
    shutdownSystem system

Opět je zde trocha magie, ale bez této definice bychom nemohli používat stavy SaveMessage a LoadMessages. Dále při spuštění aplikace nesmíme zapomenout inicializovat stavy, k tomu slouží funkce startSystemState, která očekává argument typu Proxy. Po ukončení programu se musí tyto stavy zrušit použitím funkce shutdownSystem, jinak se úložiště v adresáři _local uzamkne a my k němu nebudeme moci přistupovat. To je důvod, proč zde pomocí funkce forkIO vytvoříme nové vlákno, které pak ukončíme zavoláním funkce killThread. Každopádně jsme tímto naši aplikaci dokončili a můžeme si aplikaci vyzkoušet.

Související odkazy

• Příklad ke stažení
• Oficiální web Haskellu
• Happstack Tutorial
• Dokumentace modulů Happstack.Server, Happstack.State a Text.Html