Slides.hs

module Slides (
    slideDeck,
    titleSlide,
    pointSlide,
    codeSlide,
    ) where

import Text.Html

slideDeck :: String -> [Html] -> Html
slideDeck title slides =
    header <<
        [ thetitle << title
        , thelink ! [href "/static/slides.css", rel "stylesheet",
                   thetype "text/css"] << noHtml
        ]
    +++
    body << (slideArea : buttons : scripts)
  where
    buttons = thediv ! [ identifier "controls" ] <<
        [ anchor ! [ identifier "prev-slide", href "#" ] << "prev"
        , anchor ! [ identifier "next-slide", href "#" ] << "next"
        ]
    scripts = map mkScript [ "/static/jquery.js", "/static/Slides.js" ]
    mkScript s = tag "script" ! [ thetype "text/javascript", src s ] << noHtml
    slideArea = thediv ! [ identifier "slides" ] << slides

titleSlide :: String -> [String] -> Html
titleSlide heading subHeadings =
    thediv ! [ theclass "slide title-slide" ] <<
        (h1 << heading : map (h2 <<) subHeadings)

pointSlide :: String -> String -> [String] -> Html
pointSlide heading leadIn points =
    thediv ! [ theclass "slide bullet-slide" ] <<
        [ h1 << heading
        , if null leadIn then noHtml else p << leadIn
        , ulist << map (li <<) points
        ]

codeSlide :: String -> String -> [String] -> Html
codeSlide heading leadIn codeLines =
    thediv ! [ theclass "slide code-slide" ] <<
        [ h1 << heading
        , if null leadIn then noHtml else p << leadIn
        , pre << unlines codeLines
        ]

class SlideItem a where
    render :: a -> Html
    renderList :: [a] -> Html

instance (SlideItem a) => SlideItem [a] where
    render = renderList
    renderList as = ulist << map ((li <<).render) as
    
instance SlideItem Char where 
    render = toHtml . (:[])
    renderList = toHtml

instance SlideItem Html where
    render = id
    renderList hs = ulist << map (li <<) hs

slide :: (SlideItem a) => String -> String -> a -> Html
slide heading leadIn content = 
    thediv ! [ theclass "slide" ] <<
        [ if null heading then noHtml else h1 << heading
        , if null leadIn then noHtml else p << leadIn
        , render content
        ]