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