diff --git a/HTML5Slide.hs b/HTML5Slide.hs
--- a/HTML5Slide.hs
+++ b/HTML5Slide.hs
@@ -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
-
-
- #{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"
diff --git a/google-html5-slide.cabal b/google-html5-slide.cabal
--- a/google-html5-slide.cabal
+++ b/google-html5-slide.cabal
@@ -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