google-html5-slide 0.1.0.0 → 0.1.1.0
raw patch · 2 files changed
+283/−278 lines, 2 files
Files
- HTML5Slide.hs +282/−277
- google-html5-slide.cabal +1/−1
HTML5Slide.hs view
@@ -1,277 +1,282 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE QuasiQuotes #-}--module HTML5Slide (- HTML5SlideOptions(..), def,- writeHTML5Slide,- writeHTML5SlideString,- ) where--import Data.Default-import Data.Generics-import Data.List-import qualified Data.Text.Lazy as L-import Text.Blaze.Html-import Text.Blaze.Html.Renderer.String-import Text.Hamlet-import Text.Lucius-import Text.Pandoc-import Text.Pandoc.Highlighting--data HTML5SlideOptions- = HTML5SlideOptions- { slideScriptURL :: String- , slideClass :: String- , slideStyleCss :: String- , slideSyntaxCss :: String- }--instance Default HTML5SlideOptions where- def = HTML5SlideOptions- { slideScriptURL = "http://html5slides.googlecode.com/svn/trunk/slides.js"- , slideClass = ""- , slideStyleCss = ""- , slideSyntaxCss = L.unpack $ renderCss $ [lucius|-table.sourceCode,-tr.sourceCode,-td.lineNumbers,-td.sourceCode,-table.sourceCode pre {- margin: 0;- padding: 0;- border: 0;- vertical-align: baseline;- border: none;-}-td.lineNumbers {- border-right: 1px solid #AAAAAA;- text-align: right;- color: #AAAAAA;- padding-right: 5px;- padding-left: 5px;-}-td.sourceCode { padding-left: 5px; }-code.sourceCode span.kw { color: #007020; font-weight: bold; }-code.sourceCode span.dt { color: #902000; }-code.sourceCode span.dv { color: #40a070; }-code.sourceCode span.bn { color: #40a070; }-code.sourceCode span.fl { color: #40a070; }-code.sourceCode span.ch { color: #4070a0; }-code.sourceCode span.st { color: #4070a0; }-code.sourceCode span.co { color: #60a0b0; font-style: italic; }-code.sourceCode span.ot { color: #007020; }-code.sourceCode span.al { color: red; font-weight: bold; }-code.sourceCode span.fu { color: #06287e; }-code.sourceCode span.re { }-code.sourceCode span.er { color: red; font-weight: bold; }-|] undefined- }--writeHTML5SlideString :: WriterOptions -> HTML5SlideOptions -> Pandoc -> String-writeHTML5SlideString opt sopt pdoc = do- renderHtml $ writeHTML5Slide opt sopt pdoc--writeHTML5Slide :: WriterOptions -> HTML5SlideOptions -> Pandoc -> Html-writeHTML5Slide _ HTML5SlideOptions {..} (Pandoc Meta {..} blocks) = [shamlet|-$doctype 5-<html>- <head>- <title>#{renderInlines $ sanitizeTitle docTitle}- <meta charset="utf-8">- <script src="#{slideScriptURL}">- <style>#{slideStyleCss}- <style>#{slideSyntaxCss}-- <body style="display: none">- <section.slides.layout-regular.#{slideClass}>- $if not (null docTitle)- <article>- <h1>#{renderInlines docTitle}- <p>- $forall author <- docAuthors- #{renderInlines author}- <p>- #{renderInlines docDate}-- $forall sec <- sectionize blocks- $if isSmaller sec- <article.smaller>#{renderBlocks sec}- $else- <article>#{renderBlocks sec}-|]--sanitizeTitle :: [Inline] -> [Inline]-sanitizeTitle = everywhere (mkT $ replace "<br>" " ")--sectionize :: [Block] -> [[Block]]-sectionize [] = []-sectionize (b:bs)- | isHorizontalRule b =- sectionize bs- | isArticleBegin b =- let (cs, d:ds) = span (not . isArticleEnd) bs- in (b:cs++[d]) : sectionize ds- | otherwise =- let (cs, ds) = span (not . isSplitter) bs- in (b:cs) : sectionize ds- where- isSplitter a = isHeader a || isArticleBegin a || isHorizontalRule a-- isHeader (Header _ _) = True- isHeader _ = False-- isArticleBegin (Plain [RawInline "html" raw])- | "<article" `isPrefixOf` raw = True- isArticleBegin _ = False-- isArticleEnd (Plain [RawInline "html" "</article>"]) = True- isArticleEnd _ = False-- isHorizontalRule HorizontalRule = True- isHorizontalRule _ = False--isSmaller :: [Block] -> Bool-isSmaller = (>0) . gcount (mkQ False f) where- f (Header 3 _) = True- f _ = False--replace :: String -> String -> String -> String-replace _ _ "" = ""-replace from to ss- | from `isPrefixOf` ss = to ++ drop (length from) ss- | otherwise = head ss : replace from to (tail ss)--renderBlocks :: [Block] -> Html-renderBlocks = mapM_ renderBlock--renderBlock :: Block -> Html-renderBlock block = case block of- Plain inls -> renderInlines inls- Para inls -> [shamlet|<p>#{renderInlines inls}|]-- CodeBlock attr codestr ->- case highlight formatHtmlInline attr codestr of- Nothing ->- error $ "cannot highlighter for: " ++ show attr- Just html ->- [shamlet|<pre>#{html}|]-- RawBlock format str ->- -- TODO: use format- preEscapedToMarkup str-- -- blockquoted lists are incremental list- BlockQuote [OrderedList attr bss] ->- [shamlet|- <ol.build>- $forall bs <- bss- <li>#{renderBlocks bs}|]-- BlockQuote [BulletList bss] ->- [shamlet|- <ul.build>- $forall bs <- bss- <li>#{renderBlocks bs}|]-- BlockQuote blocks ->- [shamlet|<blockquote>#{renderBlocks blocks}|]-- OrderedList attr bss ->- [shamlet|- <ol>- $forall bs <- bss- <li>#{renderBlocks bs}|]-- BulletList bss ->- [shamlet|- <ul>- $forall bs <- bss- <li>#{renderBlocks bs}|]-- DefinitionList defs ->- [shamlet|- <dl>- $forall (t, ds) <- defs- <dd>#{renderInlines t}- $forall d <- ds- #{renderBlocks d}|]-- Header level inls ->- case level of- 1 -> [shamlet|<h2>#{renderInlines inls}|]- 2 -> [shamlet|<h3>#{renderInlines inls}|]- -- Level 3 is smaller article- 3 -> [shamlet|<h3>#{renderInlines inls}|]- _ -> error ("unsupported header level: " ++ show level)-- HorizontalRule ->- [shamlet|<hr>|]-- Table cap colAlign colWidthRatio colHeader rows ->- [shamlet|- <table>- <caption>#{renderInlines cap}- <thead>- <tr>- $forall co <- colHeader- <td>#{renderBlocks co}- <tbody>- $forall row <- rows- <tr>- $forall co <- row- <td>#{renderBlocks co}|]-- Null ->- return ()--renderInlines :: [Inline] -> Html-renderInlines = mapM_ renderInline--renderInline :: Inline -> Html-renderInline inl = case inl of- Str ss ->- [shamlet|#{ss}|]- Emph inls ->- [shamlet|<em>#{renderInlines inls}|]- Strong inls ->- [shamlet|<strong>#{renderInlines inls}|]- Strikeout inls ->- [shamlet|<del>#{renderInlines inls}|]- Superscript inls ->- [shamlet|<sup>#{renderInlines inls}|]- Subscript inls ->- [shamlet|<sub>#{renderInlines inls}|]- SmallCaps inls ->- [shamlet|<small>#{renderInlines inls}|]- Quoted SingleQuote inls ->- [shamlet|'#{renderInlines inls}'|]- Quoted DoubleQuote inls ->- [shamlet|"#{renderInlines inls}"|]- Cite cs inls ->- -- TODO: use cite info- [shamlet|<cite>#{renderInlines inls}|]- Code ("", [], []) code ->- [shamlet|<code>#{code}|]- Code attr code ->- -- TODO: implement- error $ "unsupported inline code: " ++ show attr ++ ", " ++ code- Space ->- preEscapedToMarkup (" " :: String)- LineBreak ->- [shamlet|<br>|]- Math mathType str ->- -- TODO: support it- error $ "unsupported math: " ++ show (mathType, str)- RawInline "html" str ->- preEscapedToMarkup str- RawInline format str ->- -- TODO: support it- error $ "unsupported rawinline: " ++ format- Link inls (url, title) ->- [shamlet|<a href="#{url}" alt="#{title}">#{renderInlines inls}|]- Image inls (url, title) -> do- [shamlet|<img.centered src="#{url}" alt="#{title}">|]- Note _ ->- -- TODO: support it- error "note not supported"+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE QuasiQuotes #-} + +module HTML5Slide ( + HTML5SlideOptions(..), def, + writeHTML5Slide, + writeHTML5SlideString, + ) where + +import Data.Default +import Data.Generics +import Data.List +import qualified Data.Text.Lazy as L +import Text.Blaze.Html +import Text.Blaze.Html.Renderer.String +import Text.Hamlet +import Text.Lucius +import Text.Pandoc +import Text.Pandoc.Highlighting + +data HTML5SlideOptions + = HTML5SlideOptions + { slideScriptURL :: String + , slideClass :: String + , slideStyleCss :: String + , slideSyntaxCss :: String + } + +instance Default HTML5SlideOptions where + def = HTML5SlideOptions + { slideScriptURL = "http://html5slides.googlecode.com/svn/trunk/slides.js" + , slideClass = "" + , slideStyleCss = "" + , slideSyntaxCss = L.unpack $ renderCss $ [lucius| +table.sourceCode, +tr.sourceCode, +td.lineNumbers, +td.sourceCode, +table.sourceCode pre { + margin: 0; + padding: 0; + border: 0; + vertical-align: baseline; + border: none; +} +td.lineNumbers { + border-right: 1px solid #AAAAAA; + text-align: right; + color: #AAAAAA; + padding-right: 5px; + padding-left: 5px; +} +td.sourceCode { padding-left: 5px; } +code.sourceCode span.kw { color: #007020; font-weight: bold; } +code.sourceCode span.dt { color: #902000; } +code.sourceCode span.dv { color: #40a070; } +code.sourceCode span.bn { color: #40a070; } +code.sourceCode span.fl { color: #40a070; } +code.sourceCode span.ch { color: #4070a0; } +code.sourceCode span.st { color: #4070a0; } +code.sourceCode span.co { color: #60a0b0; font-style: italic; } +code.sourceCode span.ot { color: #007020; } +code.sourceCode span.al { color: red; font-weight: bold; } +code.sourceCode span.fu { color: #06287e; } +code.sourceCode span.re { } +code.sourceCode span.er { color: red; font-weight: bold; } +|] undefined + } + +writeHTML5SlideString :: WriterOptions -> HTML5SlideOptions -> Pandoc -> String +writeHTML5SlideString opt sopt pdoc = do + renderHtml $ writeHTML5Slide opt sopt pdoc + +writeHTML5Slide :: WriterOptions -> HTML5SlideOptions -> Pandoc -> Html +writeHTML5Slide _ HTML5SlideOptions {..} (Pandoc Meta {..} blocks) = [shamlet| +$doctype 5 +<html> + <head> + <title>#{renderInlines $ sanitizeTitle docTitle} + <meta charset="utf-8"> + <script src="#{slideScriptURL}"> + <style>#{slideStyleCss} + <style>#{slideSyntaxCss} + + <body style="display: none"> + <section.slides.layout-regular.#{slideClass}> + $if not (null docTitle) + <article> + <h1>#{renderInlines docTitle} + <p> + $forall author <- docAuthors + #{renderInlines author} + <p> + #{renderInlines docDate} + + $forall sec <- sectionize blocks + $if isSmaller sec + <article.smaller>#{renderBlocks sec} + $else + <article>#{renderBlocks sec} +|] + +sanitizeTitle :: [Inline] -> [Inline] +sanitizeTitle = everywhere (mkT $ replace "<br>" " ") + +sectionize :: [Block] -> [[Block]] +sectionize [] = [] +sectionize (b:bs) + | isHorizontalRule b = + sectionize bs + | isArticleBegin b = + let (cs, d:ds) = span (not . isArticleEnd) bs + in (b:cs++[d]) : sectionize ds + | otherwise = + let (cs, ds) = span (not . isSplitter) bs + in (b:cs) : sectionize ds + where + isSplitter a = isHeader a || isArticleBegin a || isHorizontalRule a + + isHeader (Header _ _) = True + isHeader _ = False + + isArticleBegin (Plain [RawInline "html" raw]) + | "<article" `isPrefixOf` raw = True + isArticleBegin _ = False + + isArticleEnd (Plain [RawInline "html" "</article>"]) = True + isArticleEnd _ = False + + isHorizontalRule HorizontalRule = True + isHorizontalRule _ = False + +isSmaller :: [Block] -> Bool +isSmaller = (>0) . gcount (mkQ False f) where + f (Header 3 _) = True + f _ = False + +replace :: String -> String -> String -> String +replace _ _ "" = "" +replace from to ss + | from `isPrefixOf` ss = to ++ drop (length from) ss + | otherwise = head ss : replace from to (tail ss) + +renderBlocks :: [Block] -> Html +renderBlocks = mapM_ renderBlock + +renderBlock :: Block -> Html +renderBlock block = case block of + Plain inls -> renderInlines inls + Para inls -> [shamlet|<p>#{renderInlines inls}|] + + CodeBlock attr codestr -> + case highlight formatHtmlInline attr codestr of + Nothing -> + error $ "cannot highlighter for: " ++ show attr + Just html -> + [shamlet|<pre>#{html}|] + + RawBlock format str -> + -- TODO: use format + preEscapedToMarkup str + + -- blockquoted lists are incremental list + BlockQuote [OrderedList attr bss] -> + [shamlet| + <ol.build> + $forall bs <- bss + <li>#{renderBlocks bs}|] + + BlockQuote [BulletList bss] -> + [shamlet| + <ul.build> + $forall bs <- bss + <li>#{renderBlocks bs}|] + + BlockQuote blocks -> + [shamlet|<blockquote>#{renderBlocks blocks}|] + + OrderedList attr bss -> + [shamlet| + <ol> + $forall bs <- bss + <li>#{renderBlocks bs}|] + + BulletList bss -> + [shamlet| + <ul> + $forall bs <- bss + <li>#{renderBlocks bs}|] + + DefinitionList defs -> + [shamlet| + <dl> + $forall (t, ds) <- defs + <dd>#{renderInlines t} + $forall d <- ds + #{renderBlocks d}|] + + Header level inls -> + case level of + 1 -> [shamlet|<h2>#{renderInlines inls}|] + 2 -> [shamlet|<h3>#{renderInlines inls}|] + -- Level 3 is smaller article + 3 -> [shamlet|<h3>#{renderInlines inls}|] + _ -> error ("unsupported header level: " ++ show level) + + HorizontalRule -> + [shamlet|<hr>|] + + Table cap colAlign colWidthRatio colHeader rows -> + [shamlet| + <table> + <caption>#{renderInlines cap} + <thead> + <tr> + $forall co <- colHeader + <td>#{renderBlocks co} + <tbody> + $forall row <- rows + <tr> + $forall co <- row + <td>#{renderBlocks co}|] + + Null -> + return () + +renderInlines :: [Inline] -> Html +renderInlines = mapM_ renderInline + +renderInline :: Inline -> Html +renderInline inl = case inl of + Str ss -> + [shamlet|#{ss}|] + Emph inls -> + [shamlet|<em>#{renderInlines inls}|] + Strong inls -> + [shamlet|<strong>#{renderInlines inls}|] + Strikeout inls -> + [shamlet|<del>#{renderInlines inls}|] + Superscript inls -> + [shamlet|<sup>#{renderInlines inls}|] + Subscript inls -> + [shamlet|<sub>#{renderInlines inls}|] + SmallCaps inls -> + [shamlet|<small>#{renderInlines inls}|] + Quoted SingleQuote inls -> + [shamlet|'#{renderInlines inls}'|] + Quoted DoubleQuote inls -> + [shamlet|"#{renderInlines inls}"|] + Cite cs inls -> + -- TODO: use cite info + [shamlet|<cite>#{renderInlines inls}|] + Code ("", [], []) code -> + [shamlet|<code>#{code}|] + Code ("", ["url"], []) code + | '@' `elem` code -> + [shamlet|<a href="mailto:#{code}"><#{code}>|] + | otherwise -> + [shamlet|<a href="#{code}">#{code}|] + Code attr code -> + -- TODO: implement + error $ "unsupported inline code: " ++ show attr ++ ", " ++ code + Space -> + preEscapedToMarkup (" " :: String) + LineBreak -> + [shamlet|<br>|] + Math mathType str -> + -- TODO: support it + error $ "unsupported math: " ++ show (mathType, str) + RawInline "html" str -> + preEscapedToMarkup str + RawInline format str -> + -- TODO: support it + error $ "unsupported rawinline: " ++ format + Link inls (url, title) -> + [shamlet|<a href="#{url}" alt="#{title}">#{renderInlines inls}|] + Image inls (url, title) -> do + [shamlet|<img.centered src="#{url}" alt="#{title}">|] + Note _ -> + -- TODO: support it + error "note not supported"
google-html5-slide.cabal view
@@ -1,5 +1,5 @@ name: google-html5-slide -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Google HTML5 Slide generator description: Google HTML5 Slide <https://code.google.com/p/html5slides/> generator