\n*&*\n
"
, RawBlock "latex"
"\\begin[opt]{env}\nhi\n{\\end{env}"
])
, (5, do x1 <- choose (1 :: Int, 6)
- x2 <- arbitrary
+ x2 <- arbInlines (n-1)
return (Header x1 x2))
, (2, return HorizontalRule)
] ++ [x | x <- nesters, n > 0]
- where nesters = [ (5, liftM BlockQuote $ listOf $ arbBlock (n-1))
- , (5, liftM2 OrderedList arbitrary
- $ (listOf1 $ listOf1 $ arbBlock (n-1)))
+ where nesters = [ (5, liftM BlockQuote $ listOf1 $ arbBlock (n-1))
+ , (5, do x2 <- arbitrary
+ x3 <- arbitrary
+ x1 <- arbitrary `suchThat` (> 0)
+ x4 <- listOf1 $ listOf1 $ arbBlock (n-1)
+ return $ OrderedList (x1,x2,x3) x4 )
, (5, liftM BulletList $ (listOf1 $ listOf1 $ arbBlock (n-1)))
- , (5, do x1 <- listOf $ listOf1 $ listOf1 $ arbBlock (n-1)
- x2 <- arbitrary
- return (DefinitionList $ zip x2 x1))
+ , (5, do items <- listOf1 $ do
+ x1 <- listOf1 $ listOf1 $ arbBlock (n-1)
+ x2 <- arbInlines (n-1)
+ return (x2,x1)
+ return $ DefinitionList items)
, (2, do rs <- choose (1 :: Int, 4)
cs <- choose (1 :: Int, 4)
- x1 <- arbitrary
+ x1 <- arbInlines (n-1)
x2 <- vector cs
x3 <- vectorOf cs $ elements [0, 0.25]
x4 <- vectorOf cs $ listOf $ arbBlock (n-1)
diff --git a/src/Tests/Readers/Markdown.hs b/src/Tests/Readers/Markdown.hs
--- a/src/Tests/Readers/Markdown.hs
+++ b/src/Tests/Readers/Markdown.hs
@@ -6,6 +6,7 @@
import Tests.Helpers
import Tests.Arbitrary()
import Text.Pandoc.Builder
+-- import Text.Pandoc.Shared ( normalize )
import Text.Pandoc
markdown :: String -> Pandoc
@@ -16,6 +17,19 @@
=> String -> (String, c) -> Test
(=:) = test markdown
+{-
+p_markdown_round_trip :: Block -> Bool
+p_markdown_round_trip b = matches d' d''
+ where d' = normalize $ Pandoc (Meta [] [] []) [b]
+ d'' = normalize
+ $ readMarkdown defaultParserState{ stateSmart = True }
+ $ writeMarkdown defaultWriterOptions d'
+ matches (Pandoc _ [Plain []]) (Pandoc _ []) = True
+ matches (Pandoc _ [Para []]) (Pandoc _ []) = True
+ matches (Pandoc _ [Plain xs]) (Pandoc _ [Para xs']) = xs == xs'
+ matches x y = x == y
+-}
+
tests :: [Test]
tests = [ testGroup "inline code"
[ "with attribute" =:
@@ -26,4 +40,16 @@
"`*` {.haskell .special x=\"7\"}"
=?> para (codeWith ("",["haskell","special"],[("x","7")]) "*")
]
+ , testGroup "footnotes"
+ [ "indent followed by newline and flush-left text" =:
+ "[^1]\n\n[^1]: my note\n\n \nnot in note\n"
+ =?> para (note (para "my note")) +++ para "not in note"
+ , "indent followed by newline and indented text" =:
+ "[^1]\n\n[^1]: my note\n \n in note\n"
+ =?> para (note (para "my note" +++ para "in note"))
+ ]
+-- the round-trip properties frequently fail
+-- , testGroup "round trip"
+-- [ property "p_markdown_round_trip" p_markdown_round_trip
+-- ]
]
diff --git a/src/Tests/Shared.hs b/src/Tests/Shared.hs
--- a/src/Tests/Shared.hs
+++ b/src/Tests/Shared.hs
@@ -10,6 +10,8 @@
tests = [ testGroup "normalize"
[ property "p_normalize_blocks_rt" p_normalize_blocks_rt
, property "p_normalize_inlines_rt" p_normalize_inlines_rt
+ , property "p_normalize_no_trailing_spaces"
+ p_normalize_no_trailing_spaces
]
]
@@ -19,3 +21,6 @@
p_normalize_inlines_rt :: [Inline] -> Bool
p_normalize_inlines_rt ils = normalize ils == normalize (normalize ils)
+p_normalize_no_trailing_spaces :: [Inline] -> Bool
+p_normalize_no_trailing_spaces ils = null ils' || last ils' /= Space
+ where ils' = normalize $ ils ++ [Space]
diff --git a/src/Tests/Writers/HTML.hs b/src/Tests/Writers/HTML.hs
--- a/src/Tests/Writers/HTML.hs
+++ b/src/Tests/Writers/HTML.hs
@@ -38,4 +38,9 @@
, "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>="
=?> ">>="
]
+ , testGroup "images"
+ [ "alt with formatting" =:
+ image "/url" "title" ("my " +++ emph "image")
+ =?> ".
-- Assumes notes are sorted.
-footnoteSection :: [Html] -> Html
-footnoteSection notes =
+footnoteSection :: WriterOptions -> [Html] -> Html
+footnoteSection opts notes =
if null notes
then noHtml
- else thediv ! [theclass "footnotes"] $ hr +++ (olist << notes)
+ else nl opts +++ (thediv ! [theclass "footnotes"]
+ $ nl opts +++ hr +++ nl opts +++
+ (olist << (notes ++ [nl opts])) +++ nl opts)
-- | Parse a mailto link; return Just (name, domain) or Nothing.
@@ -306,20 +320,23 @@
-- | Convert Pandoc block element to HTML.
blockToHtml :: WriterOptions -> Block -> State WriterState Html
-blockToHtml _ Null = return $ noHtml
+blockToHtml _ Null = return noHtml
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 $ if writerHtml5 opts
then tag "figure" <<
- [img, tag "figcaption" << capt]
+ [nl opts, img, tag "figcaption" << capt, nl opts]
else thediv ! [theclass "figure"] <<
- [img, paragraph ! [theclass "caption"] << capt]
-blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
+ [nl opts, img, paragraph ! [theclass "caption"] << capt,
+ nl opts]
+blockToHtml opts (Para lst) = do
+ contents <- inlineListToHtml opts lst
+ return $ paragraph contents
blockToHtml _ (RawBlock "html" str) = return $ primHtml str
blockToHtml _ (RawBlock _ _) = return noHtml
-blockToHtml _ (HorizontalRule) = return $ hr
+blockToHtml _ (HorizontalRule) = return hr
blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
let classes' = if writerLiterateHaskell opts
then classes
@@ -335,7 +352,8 @@
in return $ pre ! attrs $ thecode <<
(replicate (length leadingBreaks) br +++
[stringToHtml $ addBird rawCode'])
- Right h -> modify (\st -> st{ stHighlighting = True }) >> return h
+ Right h -> modify (\st -> st{ stHighlighting = True }) >>
+ return h
blockToHtml opts (BlockQuote blocks) =
-- in S5, treat list in blockquote specially
-- if default is incremental, make it nonincremental;
@@ -348,9 +366,12 @@
[OrderedList attribs lst] ->
blockToHtml (opts {writerIncremental = inc})
(OrderedList attribs lst)
- _ -> blockListToHtml opts blocks >>=
- (return . blockquote)
- else blockListToHtml opts blocks >>= (return . blockquote)
+ _ -> do contents <- blockListToHtml opts blocks
+ return $ blockquote (nl opts +++
+ contents +++ nl opts)
+ else do
+ contents <- blockListToHtml opts blocks
+ return $ blockquote (nl opts +++ contents +++ nl opts)
blockToHtml opts (Header level lst) = do
contents <- inlineListToHtml opts lst
secnum <- liftM stSecNum get
@@ -361,20 +382,20 @@
let contents'' = if writerTableOfContents opts
then anchor ! [href $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents'
else contents'
- return $ case level of
+ return $ (case level of
1 -> h1 contents''
2 -> h2 contents''
3 -> h3 contents''
4 -> h4 contents''
5 -> h5 contents''
6 -> h6 contents''
- _ -> paragraph contents''
+ _ -> paragraph contents'')
blockToHtml opts (BulletList lst) = do
contents <- mapM (blockListToHtml opts) lst
let attribs = if writerIncremental opts
then [theclass "incremental"]
else []
- return $ unordList ! attribs $ contents
+ return $ (unordList opts contents) ! attribs
blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
contents <- mapM (blockListToHtml opts) lst
let numstyle' = camelCaseToHyphenated $ show numstyle
@@ -397,20 +418,23 @@
else [thestyle $ "list-style-type: " ++
numstyle']
else [])
- return $ ordList ! attribs $ contents
+ return $ (ordList opts contents) ! attribs
blockToHtml opts (DefinitionList lst) = do
contents <- mapM (\(term, defs) ->
do term' <- liftM (dterm <<) $ inlineListToHtml opts term
- defs' <- mapM (liftM (ddef <<) . blockListToHtml opts) defs
- return $ term' : defs') lst
+ defs' <- mapM ((liftM (\x -> ddef << (x +++ nl opts))) .
+ blockListToHtml opts) defs
+ return $ nl opts : term' : nl opts : defs') lst
let attribs = if writerIncremental opts
then [theclass "incremental"]
else []
- return $ dlist ! attribs << concat contents
+ return $ dlist ! attribs << (concat contents +++ nl opts)
blockToHtml opts (Table capt aligns widths headers rows') = do
captionDoc <- if null capt
then return noHtml
- else inlineListToHtml opts capt >>= return . caption
+ else do
+ cs <- inlineListToHtml opts capt
+ return $ caption cs +++ nl opts
let percent w = show (truncate (100*w) :: Integer) ++ "%"
let widthAttrs w = if writerHtml5 opts
then [thestyle $ "width: " ++ percent w]
@@ -418,13 +442,17 @@
let coltags = if all (== 0.0) widths
then noHtml
else concatHtml $ map
- (\w -> col ! (widthAttrs w) $ noHtml) widths
+ (\w -> (col ! (widthAttrs w)) noHtml +++ nl opts)
+ widths
head' <- if all null headers
then return noHtml
- else liftM (thead <<) $ tableRowToHtml opts aligns 0 headers
- body' <- liftM (tbody <<) $
+ else do
+ contents <- tableRowToHtml opts aligns 0 headers
+ return $ thead << (nl opts +++ contents) +++ nl opts
+ body' <- liftM (\x -> tbody << (nl opts +++ x)) $
zipWithM (tableRowToHtml opts aligns) [1..] rows'
- return $ table $ captionDoc +++ coltags +++ head' +++ body'
+ return $ table $ nl opts +++ captionDoc +++ coltags +++ head' +++
+ body' +++ nl opts
tableRowToHtml :: WriterOptions
-> [Alignment]
@@ -440,7 +468,8 @@
cols'' <- sequence $ zipWith
(\alignment item -> tableItemToHtml opts mkcell alignment item)
aligns cols'
- return $ tr ! [theclass rowclass] $ toHtmlFromList cols''
+ return $ (tr ! [theclass rowclass] $ nl opts +++ toHtmlFromList cols'')
+ +++ nl opts
alignmentToString :: Alignment -> [Char]
alignmentToString alignment = case alignment of
@@ -459,11 +488,18 @@
let alignAttrs = if writerHtml5 opts
then [thestyle $ "align: " ++ alignmentToString align']
else [align $ alignmentToString align']
- return $ tag' ! alignAttrs $ contents
+ return $ (tag' ! alignAttrs) contents +++ nl opts
+toListItems :: WriterOptions -> [Html] -> [Html]
+toListItems opts items = map (toListItem opts) items ++ [nl opts]
+
+toListItem :: WriterOptions -> Html -> Html
+toListItem opts item = nl opts +++ li item
+
blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
-blockListToHtml opts lst =
- mapM (blockToHtml opts) lst >>= return . toHtmlFromList
+blockListToHtml opts lst =
+ mapM (blockToHtml opts) lst >>=
+ return . toHtmlFromList . intersperse (nl opts)
-- | Convert list of Pandoc inline elements to HTML.
inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
@@ -566,8 +602,7 @@
if null tit then [] else [title tit]) $
linkText
(Image txt (s,tit)) -> do
- alternate <- inlineListToHtml opts txt
- let alternate' = renderFragment opts alternate
+ let alternate' = stringify txt
let attributes = [src s] ++
(if null tit
then []
@@ -610,5 +645,5 @@
_ -> otherBlocks ++ [lastBlock,
Plain backlink]
in do contents <- blockListToHtml opts blocks'
- return $ li ! [prefixedId opts ("fn" ++ ref)] $ contents
+ return $ nl opts +++ (li ! [prefixedId opts ("fn" ++ ref)]) contents
diff --git a/src/markdown2pdf.hs b/src/markdown2pdf.hs
--- a/src/markdown2pdf.hs
+++ b/src/markdown2pdf.hs
@@ -37,7 +37,7 @@
runPandoc :: [String] -> FilePath -> IO (Either String FilePath)
runPandoc inputsAndArgs output = do
- let texFile = replaceExtension output "tex"
+ let texFile = addExtension output "tex"
result <- run "pandoc" $
["-s", "--no-wrap", "-r", "markdown", "-w", "latex"]
++ inputsAndArgs ++ ["-o", texFile]
diff --git a/tests/lhs-test.fragment.html+lhs b/tests/lhs-test.fragment.html+lhs
--- a/tests/lhs-test.fragment.html+lhs
+++ b/tests/lhs-test.fragment.html+lhs
@@ -1,50 +1,15 @@
-
lhs test
unsplit is an arrow that takes a pair of values and combines them to return a single value:
> unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d
> unsplit = arr . uncurry
> -- arr (\op (x,y) -> x `op` y) (***) combines two arrows into a new arrow by running the two arrows on a pair of values (one arrow on the first item of the pair and one arrow on the second item of the pair).
f *** g = first f >>> second g
-Block quote:
+foo bar
lhs test
+ +unsplit is an arrow that takes a pair of values and combines them to return a single value:
> unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d
> unsplit = arr . uncurry
> -- arr (\op (x,y) -> x `op` y) (***) combines two arrows into a new arrow by running the two arrows on a pair of values (one arrow on the first item of the pair and one arrow on the second item of the pair).
f *** g = first f >>> second gBlock quote:
+ ++diff --git a/tests/lhs-test.html b/tests/lhs-test.html --- a/tests/lhs-test.html +++ b/tests/lhs-test.html @@ -25,55 +25,15 @@ -foo bar
+
lhs test
unsplit is an arrow that takes a pair of values and combines them to return a single value:
unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d
unsplit = arr . uncurry
-- arr (\op (x,y) -> x `op` y) (***) combines two arrows into a new arrow by running the two arrows on a pair of values (one arrow on the first item of the pair and one arrow on the second item of the pair).
f *** g = first f >>> second g
-Block quote:
+foo bar
lhs test
+unsplit is an arrow that takes a pair of values and combines them to return a single value:
unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d
unsplit = arr . uncurry
-- arr (\op (x,y) -> x `op` y) (***) combines two arrows into a new arrow by running the two arrows on a pair of values (one arrow on the first item of the pair and one arrow on the second item of the pair).
f *** g = first f >>> second g
+Block quote:
++foo bar
+