Merge branch 'master' into tests

4 files changed, 66 insertions, 22 deletions

diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs
index c752ffede..3532c1d4b 100644
--- a/src/Text/Pandoc.hs
+++ b/src/Text/Pandoc.hs
@@ -146,13 +146,15 @@ readers :: [(String, ParserState -> String -> Pandoc)]
 readers = [("native"       , \_ -> read)
           ,("json"         , \_ -> decodeJSON)
           ,("markdown"     , readMarkdown)
-          ,("markdown+lhs" , readMarkdown)
+          ,("markdown+lhs" , \st ->
+                             readMarkdown st{ stateLiterateHaskell = True})
           ,("rst"          , readRST)
           ,("textile"      , readTextile) -- TODO : textile+lhs 
           ,("rst+lhs"      , readRST)
           ,("html"         , readHtml)
           ,("latex"        , readLaTeX)
-          ,("latex+lhs"    , readLaTeX)
+          ,("latex+lhs"    , \st ->
+                             readLaTeX st{ stateLiterateHaskell = True})
           ]
 
 -- | Association list of formats and writers (omitting the
@@ -161,21 +163,25 @@ writers :: [ ( String, WriterOptions -> Pandoc -> String ) ]
 writers = [("native"       , writeNative)
           ,("json"         , \_ -> encodeJSON)
           ,("html"         , writeHtmlString)
-          ,("html+lhs"     , writeHtmlString)
+          ,("html+lhs"     , \o ->
+                             writeHtmlString o{ writerLiterateHaskell = True })
           ,("s5"           , writeHtmlString)
           ,("slidy"        , writeHtmlString)
           ,("docbook"      , writeDocbook)
           ,("opendocument" , writeOpenDocument)
           ,("latex"        , writeLaTeX)
-          ,("latex+lhs"    , writeLaTeX)
+          ,("latex+lhs"    , \o ->
+                             writeLaTeX o{ writerLiterateHaskell = True })
           ,("context"      , writeConTeXt)
           ,("texinfo"      , writeTexinfo)
           ,("man"          , writeMan)
           ,("markdown"     , writeMarkdown)
-          ,("markdown+lhs" , writeMarkdown)
+          ,("markdown+lhs" , \o ->
+                             writeMarkdown o{ writerLiterateHaskell = True })
           ,("plain"        , writePlain)
           ,("rst"          , writeRST)
-          ,("rst+lhs"      , writeRST)
+          ,("rst+lhs"      , \o ->
+                             writeRST o{ writerLiterateHaskell = True })
           ,("mediawiki"    , writeMediaWiki)
           ,("textile"      , writeTextile)
           ,("rtf"          , writeRTF)
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index cc94cf635..f757f4479 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -481,6 +481,7 @@ data WriterOptions = WriterOptions
   , writerUserDataDir      :: Maybe FilePath -- ^ Path of user data directory
   , writerCiteMethod       :: CiteMethod -- ^ How to print cites
   , writerBiblioFiles      :: [FilePath] -- ^ Biblio files to use for citations
+  , writerHtml5            :: Bool       -- ^ Produce HTML5
   } deriving Show
 
 -- | Default writer options.
@@ -510,6 +511,7 @@ defaultWriterOptions =
                 , writerUserDataDir      = Nothing
                 , writerCiteMethod       = Citeproc
                 , writerBiblioFiles      = []
+                , writerHtml5            = False
                 }
 
 --
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index b8da4bec0..901575434 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -170,6 +170,7 @@ inTemplate opts tit auths date toc body' newvars =
                     , ("pagetitle", topTitle')
                     , ("title", renderHtmlFragment tit)
                     , ("date", date') ] ++
+                    [ ("html5","true") | writerHtml5 opts ] ++
                     (case toc of
                          Just t  -> [ ("toc", renderHtmlFragment t)]
                          Nothing -> [])  ++
@@ -189,7 +190,12 @@ tableOfContents opts sects = do
   let tocList = catMaybes contents
   return $ if null tocList
               then Nothing
-              else Just $ thediv ! [prefixedId opts' "TOC"] $ unordList tocList
+              else Just $
+                   if writerHtml5 opts
+                      then tag "nav" ! [prefixedId opts' "TOC"] $
+                           unordList tocList
+                      else thediv ! [prefixedId opts' "TOC"] $
+                           unordList tocList
 
 -- | Convert section number to string
 showSecNum :: [Int] -> String
@@ -226,7 +232,9 @@ elementToHtml opts (Sec level num id' title' elements) = do
   return $ if slides   -- S5 gets confused by the extra divs around sections
               then toHtmlFromList stuff
               else if writerSectionDivs opts
-                      then thediv ! [prefixedId opts id'] << stuff
+                      then if writerHtml5 opts
+                              then tag "section" << stuff
+                              else thediv ! [prefixedId opts id'] << stuff
                       else toHtmlFromList stuff
 
 -- | Convert list of Note blocks to a footnote <div>.
@@ -296,8 +304,11 @@ blockToHtml opts (Plain lst) = inlineListToHtml opts lst
 blockToHtml opts (Para [Image txt (s,tit)]) = do
   img <- inlineToHtml opts (Image txt (s,tit))
   capt <- inlineListToHtml opts txt
-  return $ thediv ! [theclass "figure"] <<
-             [img, paragraph ! [theclass "caption"] << capt]
+  return $ if writerHtml5 opts
+              then tag "figure" <<
+                    [img, tag "figcaption" << capt]
+              else thediv ! [theclass "figure"] <<
+                    [img, paragraph ! [theclass "caption"] << capt]
 blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
 blockToHtml _ (RawHtml str) = return $ primHtml str
 blockToHtml _ (HorizontalRule) = return $ hr
@@ -368,7 +379,17 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
                    then [start startnum]
                    else []) ++
                 (if numstyle /= DefaultStyle
-                   then [thestyle $ "list-style-type: " ++ numstyle' ++ ";"]
+                   then if writerHtml5 opts
+                           then [strAttr "type" $
+                                 case numstyle of
+                                      Decimal    -> "1"
+                                      LowerAlpha -> "a"
+                                      UpperAlpha -> "A"
+                                      LowerRoman -> "i"
+                                      UpperRoman -> "I"
+                                      _          -> "1"]
+                           else [thestyle $ "list-style-type: " ++
+                                   numstyle']
                    else [])
   return $ ordList ! attribs $ contents
 blockToHtml opts (DefinitionList lst) = do
@@ -381,28 +402,30 @@ blockToHtml opts (DefinitionList lst) = do
                    else []
   return $ dlist ! attribs << concat contents
 blockToHtml opts (Table capt aligns widths headers rows') = do
-  let alignStrings = map alignmentToString aligns
   captionDoc <- if null capt
                    then return noHtml
                    else inlineListToHtml opts capt >>= return . caption
   let percent w = show (truncate (100*w) :: Integer) ++ "%"
+  let widthAttrs w = if writerHtml5 opts
+                        then [thestyle $ "width: " ++ percent w]
+                        else [width $ percent w]
   let coltags = if all (== 0.0) widths
                    then noHtml
                    else concatHtml $ map
-                         (\w -> col ! [width $ percent w] $ noHtml) widths
+                         (\w -> col ! (widthAttrs w) $ noHtml) widths
   head' <- if all null headers
               then return noHtml
-              else liftM (thead <<) $ tableRowToHtml opts alignStrings 0 headers
+              else liftM (thead <<) $ tableRowToHtml opts aligns 0 headers
   body' <- liftM (tbody <<) $
-               zipWithM (tableRowToHtml opts alignStrings) [1..] rows'
+               zipWithM (tableRowToHtml opts aligns) [1..] rows'
   return $ table $ captionDoc +++ coltags +++ head' +++ body'
 
 tableRowToHtml :: WriterOptions
-               -> [String]
+               -> [Alignment]
                -> Int
                -> [[Block]]
                -> State WriterState Html
-tableRowToHtml opts alignStrings rownum cols' = do
+tableRowToHtml opts aligns rownum cols' = do
   let mkcell = if rownum == 0 then th else td
   let rowclass = case rownum of
                       0                  -> "header"
@@ -410,7 +433,7 @@ tableRowToHtml opts alignStrings rownum cols' = do
                       _                  -> "even"
   cols'' <- sequence $ zipWith 
             (\alignment item -> tableItemToHtml opts mkcell alignment item) 
-            alignStrings cols'
+            aligns cols'
   return $ tr ! [theclass rowclass] $ toHtmlFromList cols''
 
 alignmentToString :: Alignment -> [Char]
@@ -422,12 +445,15 @@ alignmentToString alignment = case alignment of
 
 tableItemToHtml :: WriterOptions
                 -> (Html -> Html)
-                -> [Char]
+                -> Alignment
                 -> [Block]
                 -> State WriterState Html
 tableItemToHtml opts tag' align' item = do
   contents <- blockListToHtml opts item
-  return $ tag' ! [align align'] $ contents
+  let alignAttrs = if writerHtml5 opts
+                      then [thestyle $ "align: " ++ alignmentToString align']
+                      else [align $ alignmentToString align']
+  return $ tag' ! alignAttrs $ contents
 
 blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
 blockListToHtml opts lst = 
diff --git a/src/pandoc.hs b/src/pandoc.hs
index 8811e6816..2068f5fc6 100644
--- a/src/pandoc.hs
+++ b/src/pandoc.hs
@@ -41,7 +41,7 @@ import System.Exit ( exitWith, ExitCode (..) )
 import System.FilePath
 import System.Console.GetOpt
 import Data.Char ( toLower )
-import Data.List ( intercalate, isSuffixOf )
+import Data.List ( intercalate, isSuffixOf, isPrefixOf )
 import System.Directory ( getAppUserDataDirectory, doesFileExist )
 import System.IO ( stdout, stderr )
 import qualified Text.Pandoc.UTF8 as UTF8
@@ -102,6 +102,7 @@ data Opt = Opt
     , optOffline           :: Bool    -- ^ Make slideshow accessible offline
     , optXeTeX             :: Bool    -- ^ Format latex for xetex
     , optSmart             :: Bool    -- ^ Use smart typography
+    , optHtml5             :: Bool    -- ^ Produce HTML5 in HTML
     , optHTMLMathMethod    :: HTMLMathMethod -- ^ Method to print HTML math
     , optReferenceODT      :: Maybe FilePath -- ^ Path of reference.odt
     , optEPUBStylesheet    :: Maybe String   -- ^ EPUB stylesheet
@@ -142,6 +143,7 @@ defaultOpts = Opt
     , optOffline           = False
     , optXeTeX             = False
     , optSmart             = False
+    , optHtml5             = False
     , optHTMLMathMethod    = PlainMath
     , optReferenceODT      = Nothing
     , optEPUBStylesheet    = Nothing
@@ -226,6 +228,11 @@ options =
                   (\opt -> return opt { optSmart = True }))
                  "" -- "Use smart quotes, dashes, and ellipses"
 
+    , Option "5" ["html5"]
+                 (NoArg
+                  (\opt -> return opt { optHtml5 = True }))
+                 "" -- "Produce HTML5 in HTML output"
+
     , Option "m" ["latexmathml", "asciimathml"]
                  (OptArg
                   (\arg opt ->
@@ -629,6 +636,7 @@ main = do
               , optOffline           = offline
               , optXeTeX             = xetex
               , optSmart             = smart
+              , optHtml5             = html5
               , optHTMLMathMethod    = mathMethod
               , optReferenceODT      = referenceODT
               , optEPUBStylesheet    = epubStylesheet
@@ -771,7 +779,9 @@ main = do
                                                                   else obfuscationMethod,
                                       writerIdentifierPrefix = idPrefix,
                                       writerSourceDirectory  = sourceDir,
-                                      writerUserDataDir      = datadir }
+                                      writerUserDataDir      = datadir,
+                                      writerHtml5            = html5 &&
+                                                               "html" `isPrefixOf` writerName' }
 
   when (isNonTextOutput writerName' && outputFile == "-") $
     do UTF8.hPutStrLn stderr ("Error:  Cannot write " ++ writerName ++ " output to stdout.\n" ++