diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Pandoc/Definition.hs | 7 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/HTML.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/LaTeX.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 49 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/RST.hs | 6 | ||||
-rw-r--r-- | src/Text/Pandoc/Shared.hs | 10 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 9 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Docbook.hs | 10 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 9 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 9 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Man.hs | 16 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 9 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/MediaWiki.hs | 14 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/OpenDocument.hs | 8 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 6 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 7 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Texinfo.hs | 6 |
17 files changed, 106 insertions, 75 deletions
diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs index 8b91ba322..94183c500 100644 --- a/src/Text/Pandoc/Definition.hs +++ b/src/Text/Pandoc/Definition.hs @@ -79,9 +79,10 @@ data Block -- and a list of items, each a list of blocks) | BulletList [[Block]] -- ^ Bullet list (list of items, each -- a list of blocks) - | DefinitionList [([Inline],[Block])] -- ^ Definition list - -- (list of items, each a pair of an inline list, - -- the term, and a block list) + | DefinitionList [([Inline],[[Block]])] -- ^ Definition list + -- Each list item is a pair consisting of a + -- term (a list of inlines) and one or more + -- definitions (each a list of blocks) | Header Int [Inline] -- ^ Header - level (integer) and text (inlines) | HorizontalRule -- ^ Horizontal rule | Table [Inline] [Alignment] [Double] [[Block]] [[[Block]]] -- ^ Table, diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index a38450713..e6ca05d87 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -545,12 +545,12 @@ definitionList = try $ do htmlEndTag "dl" return $ DefinitionList items -definitionListItem :: GenParser Char ParserState ([Inline], [Block]) +definitionListItem :: GenParser Char ParserState ([Inline], [[Block]]) definitionListItem = try $ do terms <- sepEndBy1 (inlinesIn "dt") spaces defs <- sepEndBy1 (blocksIn "dd") spaces let term = intercalate [LineBreak] terms - return (term, concat defs) + return (term, defs) -- -- paragraph block diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 0ae24a387..b4c01fe19 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -282,7 +282,7 @@ definitionList = try $ do items <- many listItem end "description" spaces - return (DefinitionList items) + return $ DefinitionList $ map (\(t,d) -> (t,[d])) items -- -- paragraph block diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index dc556d24f..0de700537 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -555,38 +555,61 @@ bulletList = try $ do -- definition lists -definitionListItem :: GenParser Char ParserState ([Inline], [Block]) +defListMarker :: GenParser Char ParserState () +defListMarker = do + sps <- nonindentSpaces + char ':' <|> char '~' + st <- getState + let tabStop = stateTabStop st + let remaining = tabStop - (length sps + 1) + if remaining > 0 + then count remaining (char ' ') <|> string "\t" + else pzero + return () + +definitionListItem :: GenParser Char ParserState ([Inline], [[Block]]) definitionListItem = try $ do - notFollowedBy blankline - notFollowedBy' indentSpaces -- first, see if this has any chance of being a definition list: - lookAhead (anyLine >> char ':') + lookAhead (anyLine >> optional blankline >> defListMarker) term <- manyTill inline newline + optional blankline raw <- many1 defRawBlock state <- getState let oldContext = stateParserContext state -- parse the extracted block, which may contain various block elements: - contents <- parseFromString parseBlocks $ concat raw + contents <- mapM (parseFromString parseBlocks) raw updateState (\st -> st {stateParserContext = oldContext}) return ((normalizeSpaces term), contents) defRawBlock :: GenParser Char ParserState [Char] defRawBlock = try $ do - char ':' - state <- getState - let tabStop = stateTabStop state - try (count (tabStop - 1) (char ' ')) <|> (many (char ' ') >> string "\t") + defListMarker firstline <- anyLine rawlines <- many (notFollowedBy blankline >> indentSpaces >> anyLine) trailing <- option "" blanklines - return $ firstline ++ "\n" ++ unlines rawlines ++ trailing + cont <- liftM concat $ many $ do + lns <- many1 $ notFollowedBy blankline >> indentSpaces >> anyLine + trl <- option "" blanklines + return $ unlines lns ++ trl + return $ firstline ++ "\n" ++ unlines rawlines ++ trailing ++ cont definitionList :: GenParser Char ParserState Block definitionList = do items <- many1 definitionListItem - let (terms, defs) = unzip items - let defs' = compactify defs - let items' = zip terms defs' + -- "compactify" the definition list: + let defs = map snd items + let defBlocks = reverse $ concat $ concat defs + let isPara (Para _) = True + isPara _ = False + let items' = case take 1 defBlocks of + [Para x] -> if not $ any isPara (drop 1 defBlocks) + then let (t,ds) = last items + lastDef = last ds + ds' = init ds ++ + [init lastDef ++ [Plain x]] + in init items ++ [(t, ds')] + else items + _ -> items return $ DefinitionList items' -- diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 9e38b1872..d1515c4d5 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -174,7 +174,7 @@ fieldList = try $ do else do terms <- mapM (return . (:[]) . Str . fst) remaining defs <- mapM (parseFromString (many block) . snd) remaining - return $ DefinitionList $ zip terms defs + return $ DefinitionList $ zip terms $ map (:[]) defs -- -- line block @@ -397,7 +397,7 @@ blockQuote = do list :: GenParser Char ParserState Block list = choice [ bulletList, orderedList, definitionList ] <?> "list" -definitionListItem :: GenParser Char ParserState ([Inline], [Block]) +definitionListItem :: GenParser Char ParserState ([Inline], [[Block]]) definitionListItem = try $ do -- avoid capturing a directive or comment notFollowedBy (try $ char '.' >> char '.') @@ -405,7 +405,7 @@ definitionListItem = try $ do raw <- indentedBlock -- parse the extracted block, which may contain various block elements: contents <- parseFromString parseBlocks $ raw ++ "\n\n" - return (normalizeSpaces term, contents) + return (normalizeSpaces term, [contents]) definitionList :: GenParser Char ParserState Block definitionList = many1 definitionListItem >>= return . DefinitionList diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 0e8eff217..6f11d0200 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -796,10 +796,12 @@ prettyBlock (OrderedList attribs blockLists) = prettyBlock (BulletList blockLists) = "BulletList\n" ++ indentBy 2 0 ("[ " ++ (intercalate ", " (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]" -prettyBlock (DefinitionList blockLists) = "DefinitionList\n" ++ - indentBy 2 0 ("[" ++ (intercalate ",\n" - (map (\(term, blocks) -> " (" ++ show term ++ ",\n" ++ - indentBy 1 2 (prettyBlockList 2 blocks) ++ " )") blockLists))) ++ " ]" +prettyBlock (DefinitionList items) = "DefinitionList\n" ++ + indentBy 2 0 ("[ " ++ (intercalate "\n, " + (map (\(term, defs) -> "(" ++ show term ++ ",\n" ++ + indentBy 3 0 ("[ " ++ (intercalate ", " + (map (\blocks -> prettyBlockList 2 blocks) defs)) ++ "]") ++ + ")") items))) ++ " ]" prettyBlock (Table caption aligns widths header rows) = "Table " ++ show caption ++ " " ++ show aligns ++ " " ++ show widths ++ "\n" ++ prettyRow header ++ " [\n" ++ diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 25902387b..142c862ef 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -31,8 +31,9 @@ module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Printf ( printf ) -import Data.List ( isSuffixOf, intercalate ) +import Data.List ( isSuffixOf, intercalate, intersperse ) import Control.Monad.State +import Control.Monad (liftM) import Text.PrettyPrint.HughesPJ hiding ( Str ) data WriterState = @@ -221,10 +222,10 @@ listItemToConTeXt :: [Block] -> State WriterState Doc listItemToConTeXt list = blockListToConTeXt list >>= return . (text "\\item" $$) . (nest 2) -defListItemToConTeXt :: ([Inline], [Block]) -> State WriterState BlockWrapper -defListItemToConTeXt (term, def) = do +defListItemToConTeXt :: ([Inline], [[Block]]) -> State WriterState BlockWrapper +defListItemToConTeXt (term, defs) = do term' <- inlineListToConTeXt term - def' <- blockListToConTeXt def + def' <- liftM (vcat . intersperse (text "")) $ mapM blockListToConTeXt defs return $ Pad $ text "\\startdescr{" <> term' <> char '}' $$ def' $$ text "\\stopdescr" -- | Convert list of block elements to ConTeXt. diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 13f670ab2..b4f760e6c 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -102,14 +102,14 @@ plainToPara x = x -- | Convert a list of pairs of terms and definitions into a list of -- Docbook varlistentrys. -deflistItemsToDocbook :: WriterOptions -> [([Inline],[Block])] -> Doc +deflistItemsToDocbook :: WriterOptions -> [([Inline],[[Block]])] -> Doc deflistItemsToDocbook opts items = - vcat $ map (\(term, def) -> deflistItemToDocbook opts term def) items + vcat $ map (\(term, defs) -> deflistItemToDocbook opts term defs) items -- | Convert a term and a list of blocks into a Docbook varlistentry. -deflistItemToDocbook :: WriterOptions -> [Inline] -> [Block] -> Doc -deflistItemToDocbook opts term def = - let def' = map plainToPara def +deflistItemToDocbook :: WriterOptions -> [Inline] -> [[Block]] -> Doc +deflistItemToDocbook opts term defs = + let def' = concatMap (map plainToPara) defs in inTagsIndented "varlistentry" $ inTagsIndented "term" (inlinesToDocbook opts term) $$ inTagsIndented "listitem" (blocksToDocbook opts def') diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 5c764a635..9e397477e 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -316,13 +316,14 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do else []) return $ ordList ! attribs $ contents blockToHtml opts (DefinitionList lst) = do - contents <- mapM (\(term, def) -> do term' <- inlineListToHtml opts term - def' <- blockListToHtml opts def - return $ (term', def')) lst + contents <- mapM (\(term, defs) -> + do term' <- liftM (dterm <<) $ inlineListToHtml opts term + defs' <- mapM (liftM (ddef <<) . blockListToHtml opts) defs + return $ term' : defs') lst let attribs = if writerIncremental opts then [theclass "incremental"] else [] - return $ defList ! attribs $ contents + return $ dlist ! attribs << concat contents blockToHtml opts (Table capt aligns widths headers rows') = do let alignStrings = map alignmentToString aligns captionDoc <- if null capt diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 0ced9d781..af23f9285 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -31,10 +31,11 @@ module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Printf ( printf ) -import Data.List ( (\\), isSuffixOf, intercalate ) +import Data.List ( (\\), isSuffixOf, intercalate, intersperse ) import Data.Char ( toLower ) import qualified Data.Set as S import Control.Monad.State +import Control.Monad (liftM) import Text.PrettyPrint.HughesPJ hiding ( Str ) data WriterState = @@ -250,10 +251,10 @@ listItemToLaTeX :: [Block] -> State WriterState Doc listItemToLaTeX lst = blockListToLaTeX lst >>= return . (text "\\item" $$) . (nest 2) -defListItemToLaTeX :: ([Inline], [Block]) -> State WriterState Doc -defListItemToLaTeX (term, def) = do +defListItemToLaTeX :: ([Inline], [[Block]]) -> State WriterState Doc +defListItemToLaTeX (term, defs) = do term' <- inlineListToLaTeX $ deVerb term - def' <- blockListToLaTeX def + def' <- liftM (vcat . intersperse (text "")) $ mapM blockListToLaTeX defs return $ text "\\item[" <> term' <> text "]" $$ def' -- | Convert list of inline elements to LaTeX. diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 616795e31..3270337d7 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -242,19 +242,19 @@ orderedListItemToMan opts num indent (first:rest) = do -- | Convert definition list item (label, list of blocks) to man. definitionListItemToMan :: WriterOptions - -> ([Inline],[Block]) + -> ([Inline],[[Block]]) -> State WriterState Doc -definitionListItemToMan opts (label, items) = do +definitionListItemToMan opts (label, defs) = do labelText <- inlineListToMan opts label - contents <- if null items + contents <- if null defs then return empty - else do - let (first, rest) = case items of + else liftM vcat $ forM defs $ \blocks -> do + let (first, rest) = case blocks of ((Para x):y) -> (Plain x,y) (x:y) -> (x,y) - [] -> error "items is null" - rest' <- mapM (\item -> blockToMan opts item) - rest >>= (return . vcat) + [] -> error "blocks is null" + rest' <- liftM vcat $ + mapM (\item -> blockToMan opts item) rest first' <- blockToMan opts first return $ first' $$ text ".RS" $$ rest' $$ text ".RE" return $ text ".TP\n.B " <> labelText $+$ contents diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index d500d4caf..31b12976d 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -279,15 +279,14 @@ orderedListItemToMarkdown opts marker items = do -- | Convert definition list item (label, list of blocks) to markdown. definitionListItemToMarkdown :: WriterOptions - -> ([Inline],[Block]) + -> ([Inline],[[Block]]) -> State WriterState Doc -definitionListItemToMarkdown opts (label, items) = do +definitionListItemToMarkdown opts (label, defs) = do labelText <- inlineListToMarkdown opts label let tabStop = writerTabStop opts let leader = char ':' - contents <- mapM (\item -> blockToMarkdown opts item >>= - (\txt -> return (leader $$ nest tabStop txt))) - items >>= return . vcat + contents <- liftM vcat $ + mapM (liftM ((leader $$) . nest tabStop . vcat) . mapM (blockToMarkdown opts)) defs return $ labelText $+$ contents -- | Convert list of Pandoc block elements to markdown. diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 03fae18ba..1e7194621 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -33,7 +33,7 @@ module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Pandoc.XML ( escapeStringForXML ) -import Data.List ( intersect ) +import Data.List ( intersect, intercalate ) import Network.URI ( isURI ) import Control.Monad.State @@ -199,17 +199,19 @@ listItemToMediaWiki opts items = do -- | Convert definition list item (label, list of blocks) to MediaWiki. definitionListItemToMediaWiki :: WriterOptions - -> ([Inline],[Block]) + -> ([Inline],[[Block]]) -> State WriterState String definitionListItemToMediaWiki opts (label, items) = do labelText <- inlineListToMediaWiki opts label - contents <- blockListToMediaWiki opts items + contents <- mapM (blockListToMediaWiki opts) items useTags <- get >>= return . stUseTags if useTags - then return $ "<dt>" ++ labelText ++ "</dt>\n<dd>" ++ contents ++ "</dd>" + then return $ "<dt>" ++ labelText ++ "</dt>\n" ++ + (intercalate "\n" $ map (\d -> "<dd>" ++ d ++ "</dd>") contents) else do marker <- get >>= return . stListLevel - return $ marker ++ " " ++ labelText ++ "\n" ++ (init marker ++ ": ") ++ contents + return $ marker ++ " " ++ labelText ++ "\n" ++ + (intercalate "\n" $ map (\d -> init marker ++ ": " ++ d) contents) -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. isSimpleList :: Block -> Bool @@ -218,7 +220,7 @@ isSimpleList x = BulletList items -> all isSimpleListItem items OrderedList (num, sty, _) items -> all isSimpleListItem items && num == 1 && sty `elem` [DefaultStyle, Decimal] - DefinitionList items -> all isSimpleListItem $ map snd items + DefinitionList items -> all isSimpleListItem $ concatMap snd items _ -> False -- | True if list item can be handled with the simple wiki syntax. False if diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 7ef70a0d2..15e7f30bd 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -260,14 +260,14 @@ listItemsToOpenDocument :: String -> WriterOptions -> [[Block]] -> State WriterS listItemsToOpenDocument s o is = vcat . map (inTagsIndented "text:list-item") <$> mapM (withParagraphStyle o s . map plainToPara) is -deflistItemToOpenDocument :: WriterOptions -> ([Inline],[Block]) -> State WriterState Doc +deflistItemToOpenDocument :: WriterOptions -> ([Inline],[[Block]]) -> State WriterState Doc deflistItemToOpenDocument o (t,d) = do - let ts = if isTightList [d] + let ts = if isTightList d then "Definition_20_Term_20_Tight" else "Definition_20_Term" - ds = if isTightList [d] + ds = if isTightList d then "Definition_20_Definition_20_Tight" else "Definition_20_Definition" t' <- withParagraphStyle o ts [Para t] - d' <- withParagraphStyle o ds (map plainToPara d) + d' <- liftM vcat $ mapM (withParagraphStyle o ds . (map plainToPara)) d return $ t' $$ d' inBlockQuote :: WriterOptions -> Int -> [Block] -> State WriterState Doc diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 22d453620..31c039bd7 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -257,10 +257,10 @@ orderedListItemToRST marker items = do return $ (text marker <> char ' ') <> contents -- | Convert defintion list item (label, list of blocks) to RST. -definitionListItemToRST :: ([Inline], [Block]) -> State WriterState Doc -definitionListItemToRST (label, items) = do +definitionListItemToRST :: ([Inline], [[Block]]) -> State WriterState Doc +definitionListItemToRST (label, defs) = do label' <- inlineListToRST label - contents <- blockListToRST items + contents <- liftM vcat $ mapM blockListToRST defs tabstop <- get >>= (return . writerTabStop . stOptions) return $ label' $+$ nest tabstop contents diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index f8bd0cd2b..2376557a8 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -247,11 +247,12 @@ listItemToRTF alignment indent marker list = -- | Convert definition list item (label, list of blocks) to RTF. definitionListItemToRTF :: Alignment -- ^ alignment -> Int -- ^ indent level - -> ([Inline],[Block]) -- ^ list item (list of blocks) + -> ([Inline],[[Block]]) -- ^ list item (list of blocks) -> [Char] -definitionListItemToRTF alignment indent (label, items) = +definitionListItemToRTF alignment indent (label, defs) = let labelText = blockToRTF indent alignment (Plain label) - itemsText = concatMap (blockToRTF (indent + listIncrement) alignment) items + itemsText = concatMap (blockToRTF (indent + listIncrement) alignment) $ + concat defs in labelText ++ itemsText -- | Convert list of inline items to RTF. diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index a0986241b..5b706d24b 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -339,11 +339,11 @@ listItemToTexinfo :: [Block] listItemToTexinfo lst = blockListToTexinfo lst >>= return . (text "@item" $$) -defListItemToTexinfo :: ([Inline], [Block]) +defListItemToTexinfo :: ([Inline], [[Block]]) -> State WriterState Doc -defListItemToTexinfo (term, def) = do +defListItemToTexinfo (term, defs) = do term' <- inlineListToTexinfo term - def' <- blockListToTexinfo def + def' <- liftM vcat $ mapM blockListToTexinfo defs return $ text "@item " <> term' <> text "\n" $$ def' -- | Convert list of inline elements to Texinfo. |