Removed space at ends of lines in source.

This commit is contained in:
John MacFarlane 2014-07-12 22:57:22 -07:00
parent 8bbcff0cfc
commit 4676bfdf82
12 changed files with 96 additions and 96 deletions

View file

@ -303,7 +303,7 @@ getReader :: String -> Either String Reader
getReader s = getReader s =
case parseFormatSpec s of case parseFormatSpec s of
Left e -> Left $ intercalate "\n" $ [m | Message m <- errorMessages e] Left e -> Left $ intercalate "\n" $ [m | Message m <- errorMessages e]
Right (readerName, setExts) -> Right (readerName, setExts) ->
case lookup readerName readers of case lookup readerName readers of
Nothing -> Left $ "Unknown reader: " ++ readerName Nothing -> Left $ "Unknown reader: " ++ readerName
Just (StringReader r) -> Right $ StringReader $ \o -> Just (StringReader r) -> Right $ StringReader $ \o ->

View file

@ -1,4 +1,4 @@
{-# LANGUAGE {-# LANGUAGE
FlexibleContexts FlexibleContexts
, GeneralizedNewtypeDeriving , GeneralizedNewtypeDeriving
, TypeSynonymInstances , TypeSynonymInstances
@ -100,7 +100,7 @@ module Text.Pandoc.Parsing ( anyLine,
macro, macro,
applyMacros', applyMacros',
Parser, Parser,
ParserT, ParserT,
F(..), F(..),
runF, runF,
askF, askF,
@ -222,7 +222,7 @@ anyLine = do
_ -> mzero _ -> mzero
-- | Like @manyTill@, but reads at least one item. -- | Like @manyTill@, but reads at least one item.
many1Till :: Stream s m t many1Till :: Stream s m t
=> ParserT s st m a => ParserT s st m a
-> ParserT s st m end -> ParserT s st m end
-> ParserT s st m [a] -> ParserT s st m [a]
@ -501,7 +501,7 @@ mathInline =
-- displacement (the difference between the source column at the end -- displacement (the difference between the source column at the end
-- and the source column at the beginning). Vertical displacement -- and the source column at the beginning). Vertical displacement
-- (source row) is ignored. -- (source row) is ignored.
withHorizDisplacement :: Stream s m Char withHorizDisplacement :: Stream s m Char
=> ParserT s st m a -- ^ Parser to apply => ParserT s st m a -- ^ Parser to apply
-> ParserT s st m (a, Int) -- ^ (result, displacement) -> ParserT s st m (a, Int) -- ^ (result, displacement)
withHorizDisplacement parser = do withHorizDisplacement parser = do
@ -528,7 +528,7 @@ withRaw parser = do
return (result, raw) return (result, raw)
-- | Parses backslash, then applies character parser. -- | Parses backslash, then applies character parser.
escaped :: Stream s m Char escaped :: Stream s m Char
=> ParserT s st m Char -- ^ Parser for character to escape => ParserT s st m Char -- ^ Parser for character to escape
-> ParserT s st m Char -> ParserT s st m Char
escaped parser = try $ char '\\' >> parser escaped parser = try $ char '\\' >> parser
@ -564,7 +564,7 @@ decimal = do
-- returns (DefaultStyle, [next example number]). The next -- returns (DefaultStyle, [next example number]). The next
-- example number is incremented in parser state, and the label -- example number is incremented in parser state, and the label
-- (if present) is added to the label table. -- (if present) is added to the label table.
exampleNum :: Stream s m Char exampleNum :: Stream s m Char
=> ParserT s ParserState m (ListNumberStyle, Int) => ParserT s ParserState m (ListNumberStyle, Int)
exampleNum = do exampleNum = do
char '@' char '@'
@ -609,7 +609,7 @@ anyOrderedListMarker = choice $
lowerAlpha, lowerRoman, upperAlpha, upperRoman]] lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
-- | Parses a list number (num) followed by a period, returns list attributes. -- | Parses a list number (num) followed by a period, returns list attributes.
inPeriod :: Stream s m Char inPeriod :: Stream s m Char
=> ParserT s st m (ListNumberStyle, Int) => ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes -> ParserT s st m ListAttributes
inPeriod num = try $ do inPeriod num = try $ do
@ -621,7 +621,7 @@ inPeriod num = try $ do
return (start, style, delim) return (start, style, delim)
-- | Parses a list number (num) followed by a paren, returns list attributes. -- | Parses a list number (num) followed by a paren, returns list attributes.
inOneParen :: Stream s m Char inOneParen :: Stream s m Char
=> ParserT s st m (ListNumberStyle, Int) => ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes -> ParserT s st m ListAttributes
inOneParen num = try $ do inOneParen num = try $ do
@ -630,7 +630,7 @@ inOneParen num = try $ do
return (start, style, OneParen) return (start, style, OneParen)
-- | Parses a list number (num) enclosed in parens, returns list attributes. -- | Parses a list number (num) enclosed in parens, returns list attributes.
inTwoParens :: Stream s m Char inTwoParens :: Stream s m Char
=> ParserT s st m (ListNumberStyle, Int) => ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes -> ParserT s st m ListAttributes
inTwoParens num = try $ do inTwoParens num = try $ do
@ -641,7 +641,7 @@ inTwoParens num = try $ do
-- | Parses an ordered list marker with a given style and delimiter, -- | Parses an ordered list marker with a given style and delimiter,
-- returns number. -- returns number.
orderedListMarker :: Stream s m Char orderedListMarker :: Stream s m Char
=> ListNumberStyle => ListNumberStyle
-> ListNumberDelim -> ListNumberDelim
-> ParserT s ParserState m Int -> ParserT s ParserState m Int
@ -688,7 +688,7 @@ lineBlockLines = try $ do
-- | Parse a table using 'headerParser', 'rowParser', -- | Parse a table using 'headerParser', 'rowParser',
-- 'lineParser', and 'footerParser'. -- 'lineParser', and 'footerParser'.
tableWith :: Stream s m Char tableWith :: Stream s m Char
=> ParserT s ParserState m ([[Block]], [Alignment], [Int]) => ParserT s ParserState m ([[Block]], [Alignment], [Int])
-> ([Int] -> ParserT s ParserState m [[Block]]) -> ([Int] -> ParserT s ParserState m [[Block]])
-> ParserT s ParserState m sep -> ParserT s ParserState m sep
@ -735,7 +735,7 @@ widthsFromIndices numColumns' indices =
-- (which may be grid), then the rows, -- (which may be grid), then the rows,
-- which may be grid, separated by blank lines, and -- which may be grid, separated by blank lines, and
-- ending with a footer (dashed line followed by blank line). -- ending with a footer (dashed line followed by blank line).
gridTableWith :: Stream [Char] m Char gridTableWith :: Stream [Char] m Char
=> ParserT [Char] ParserState m [Block] -- ^ Block list parser => ParserT [Char] ParserState m [Block] -- ^ Block list parser
-> Bool -- ^ Headerless table -> Bool -- ^ Headerless table
-> ParserT [Char] ParserState m Block -> ParserT [Char] ParserState m Block
@ -765,7 +765,7 @@ gridTableSep :: Stream s m Char => Char -> ParserT s ParserState m Char
gridTableSep ch = try $ gridDashedLines ch >> return '\n' gridTableSep ch = try $ gridDashedLines ch >> return '\n'
-- | Parse header for a grid table. -- | Parse header for a grid table.
gridTableHeader :: Stream [Char] m Char gridTableHeader :: Stream [Char] m Char
=> Bool -- ^ Headerless table => Bool -- ^ Headerless table
-> ParserT [Char] ParserState m [Block] -> ParserT [Char] ParserState m [Block]
-> ParserT [Char] ParserState m ([[Block]], [Alignment], [Int]) -> ParserT [Char] ParserState m ([[Block]], [Alignment], [Int])
@ -798,7 +798,7 @@ gridTableRawLine indices = do
return (gridTableSplitLine indices line) return (gridTableSplitLine indices line)
-- | Parse row of grid table. -- | Parse row of grid table.
gridTableRow :: Stream [Char] m Char gridTableRow :: Stream [Char] m Char
=> ParserT [Char] ParserState m [Block] => ParserT [Char] ParserState m [Block]
-> [Int] -> [Int]
-> ParserT [Char] ParserState m [[Block]] -> ParserT [Char] ParserState m [[Block]]
@ -826,7 +826,7 @@ gridTableFooter = blanklines
--- ---
-- | Parse a string with a given parser and state. -- | Parse a string with a given parser and state.
readWith :: (Show s, Stream s Identity Char) readWith :: (Show s, Stream s Identity Char)
=> ParserT s st Identity a -- ^ parser => ParserT s st Identity a -- ^ parser
-> st -- ^ initial state -> st -- ^ initial state
-> s -- ^ input -> s -- ^ input
@ -844,7 +844,7 @@ readWith parser state input =
Right result -> result Right result -> result
-- | Parse a string with @parser@ (for testing). -- | Parse a string with @parser@ (for testing).
testStringWith :: (Show s, Show a, Stream s Identity Char) testStringWith :: (Show s, Show a, Stream s Identity Char)
=> ParserT s ParserState Identity a => ParserT s ParserState Identity a
-> s -> s
-> IO () -> IO ()
@ -1038,7 +1038,7 @@ registerHeader (ident,classes,kvs) header' = do
failUnlessSmart :: (Stream s m a, HasReaderOptions st) => ParserT s st m () failUnlessSmart :: (Stream s m a, HasReaderOptions st) => ParserT s st m ()
failUnlessSmart = getOption readerSmart >>= guard failUnlessSmart = getOption readerSmart >>= guard
smartPunctuation :: Stream s m Char smartPunctuation :: Stream s m Char
=> ParserT s ParserState m Inlines => ParserT s ParserState m Inlines
-> ParserT s ParserState m Inlines -> ParserT s ParserState m Inlines
smartPunctuation inlineParser = do smartPunctuation inlineParser = do
@ -1048,12 +1048,12 @@ smartPunctuation inlineParser = do
apostrophe :: Stream s m Char => ParserT s st m Inlines apostrophe :: Stream s m Char => ParserT s st m Inlines
apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\x2019") apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\x2019")
quoted :: Stream s m Char quoted :: Stream s m Char
=> ParserT s ParserState m Inlines => ParserT s ParserState m Inlines
-> ParserT s ParserState m Inlines -> ParserT s ParserState m Inlines
quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser
withQuoteContext :: Stream s m t withQuoteContext :: Stream s m t
=> QuoteContext => QuoteContext
-> ParserT s ParserState m a -> ParserT s ParserState m a
-> ParserT s ParserState m a -> ParserT s ParserState m a
@ -1066,7 +1066,7 @@ withQuoteContext context parser = do
setState newState { stateQuoteContext = oldQuoteContext } setState newState { stateQuoteContext = oldQuoteContext }
return result return result
singleQuoted :: Stream s m Char singleQuoted :: Stream s m Char
=> ParserT s ParserState m Inlines => ParserT s ParserState m Inlines
-> ParserT s ParserState m Inlines -> ParserT s ParserState m Inlines
singleQuoted inlineParser = try $ do singleQuoted inlineParser = try $ do
@ -1074,7 +1074,7 @@ singleQuoted inlineParser = try $ do
withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>= withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>=
return . B.singleQuoted . mconcat return . B.singleQuoted . mconcat
doubleQuoted :: Stream s m Char doubleQuoted :: Stream s m Char
=> ParserT s ParserState m Inlines => ParserT s ParserState m Inlines
-> ParserT s ParserState m Inlines -> ParserT s ParserState m Inlines
doubleQuoted inlineParser = try $ do doubleQuoted inlineParser = try $ do
@ -1082,8 +1082,8 @@ doubleQuoted inlineParser = try $ do
withQuoteContext InDoubleQuote $ manyTill inlineParser doubleQuoteEnd >>= withQuoteContext InDoubleQuote $ manyTill inlineParser doubleQuoteEnd >>=
return . B.doubleQuoted . mconcat return . B.doubleQuoted . mconcat
failIfInQuoteContext :: Stream s m t failIfInQuoteContext :: Stream s m t
=> QuoteContext => QuoteContext
-> ParserT s ParserState m () -> ParserT s ParserState m ()
failIfInQuoteContext context = do failIfInQuoteContext context = do
st <- getState st <- getState
@ -1097,7 +1097,7 @@ charOrRef cs =
guard (c `elem` cs) guard (c `elem` cs)
return c) return c)
singleQuoteStart :: Stream s m Char singleQuoteStart :: Stream s m Char
=> ParserT s ParserState m () => ParserT s ParserState m ()
singleQuoteStart = do singleQuoteStart = do
failIfInQuoteContext InSingleQuote failIfInQuoteContext InSingleQuote
@ -1105,24 +1105,24 @@ singleQuoteStart = do
guard =<< notAfterString guard =<< notAfterString
() <$ charOrRef "'\8216\145" () <$ charOrRef "'\8216\145"
singleQuoteEnd :: Stream s m Char singleQuoteEnd :: Stream s m Char
=> ParserT s st m () => ParserT s st m ()
singleQuoteEnd = try $ do singleQuoteEnd = try $ do
charOrRef "'\8217\146" charOrRef "'\8217\146"
notFollowedBy alphaNum notFollowedBy alphaNum
doubleQuoteStart :: Stream s m Char doubleQuoteStart :: Stream s m Char
=> ParserT s ParserState m () => ParserT s ParserState m ()
doubleQuoteStart = do doubleQuoteStart = do
failIfInQuoteContext InDoubleQuote failIfInQuoteContext InDoubleQuote
try $ do charOrRef "\"\8220\147" try $ do charOrRef "\"\8220\147"
notFollowedBy . satisfy $ flip elem [' ', '\t', '\n'] notFollowedBy . satisfy $ flip elem [' ', '\t', '\n']
doubleQuoteEnd :: Stream s m Char doubleQuoteEnd :: Stream s m Char
=> ParserT s st m () => ParserT s st m ()
doubleQuoteEnd = void (charOrRef "\"\8221\148") doubleQuoteEnd = void (charOrRef "\"\8221\148")
ellipses :: Stream s m Char ellipses :: Stream s m Char
=> ParserT s st m Inlines => ParserT s st m Inlines
ellipses = do ellipses = do
try (charOrRef "\8230\133") <|> try (string "..." >> return '…') try (charOrRef "\8230\133") <|> try (string "..." >> return '…')
@ -1136,32 +1136,32 @@ dash = do
else B.str <$> (hyphenDash <|> emDash <|> enDash) else B.str <$> (hyphenDash <|> emDash <|> enDash)
-- Two hyphens = en-dash, three = em-dash -- Two hyphens = en-dash, three = em-dash
hyphenDash :: Stream s m Char hyphenDash :: Stream s m Char
=> ParserT s st m String => ParserT s st m String
hyphenDash = do hyphenDash = do
try $ string "--" try $ string "--"
option "\8211" (char '-' >> return "\8212") option "\8211" (char '-' >> return "\8212")
emDash :: Stream s m Char emDash :: Stream s m Char
=> ParserT s st m String => ParserT s st m String
emDash = do emDash = do
try (charOrRef "\8212\151") try (charOrRef "\8212\151")
return "\8212" return "\8212"
enDash :: Stream s m Char enDash :: Stream s m Char
=> ParserT s st m String => ParserT s st m String
enDash = do enDash = do
try (charOrRef "\8212\151") try (charOrRef "\8212\151")
return "\8211" return "\8211"
enDashOld :: Stream s m Char enDashOld :: Stream s m Char
=> ParserT s st m Inlines => ParserT s st m Inlines
enDashOld = do enDashOld = do
try (charOrRef "\8211\150") <|> try (charOrRef "\8211\150") <|>
try (char '-' >> lookAhead (satisfy isDigit) >> return '') try (char '-' >> lookAhead (satisfy isDigit) >> return '')
return (B.str "\8211") return (B.str "\8211")
emDashOld :: Stream s m Char emDashOld :: Stream s m Char
=> ParserT s st m Inlines => ParserT s st m Inlines
emDashOld = do emDashOld = do
try (charOrRef "\8212\151") <|> (try $ string "--" >> optional (char '-') >> return '-') try (charOrRef "\8212\151") <|> (try $ string "--" >> optional (char '-') >> return '-')
@ -1169,7 +1169,7 @@ emDashOld = do
-- This is used to prevent exponential blowups for things like: -- This is used to prevent exponential blowups for things like:
-- a**a*a**a*a**a*a**a*a**a*a**a*a** -- a**a*a**a*a**a*a**a*a**a*a**a*a**
nested :: Stream s m a nested :: Stream s m a
=> ParserT s ParserState m a => ParserT s ParserState m a
-> ParserT s ParserState m a -> ParserT s ParserState m a
nested p = do nested p = do
@ -1198,7 +1198,7 @@ citeKey = try $ do
-- --
-- | Parse a \newcommand or \renewcommand macro definition. -- | Parse a \newcommand or \renewcommand macro definition.
macro :: (Stream [Char] m Char, HasMacros st, HasReaderOptions st) macro :: (Stream [Char] m Char, HasMacros st, HasReaderOptions st)
=> ParserT [Char] st m Blocks => ParserT [Char] st m Blocks
macro = do macro = do
apply <- getOption readerApplyMacros apply <- getOption readerApplyMacros
@ -1214,8 +1214,8 @@ macro = do
else return $ rawBlock "latex" def' else return $ rawBlock "latex" def'
-- | Apply current macros to string. -- | Apply current macros to string.
applyMacros' :: Stream [Char] m Char applyMacros' :: Stream [Char] m Char
=> String => String
-> ParserT [Char] ParserState m String -> ParserT [Char] ParserState m String
applyMacros' target = do applyMacros' target = do
apply <- getOption readerApplyMacros apply <- getOption readerApplyMacros

View file

@ -150,7 +150,7 @@ runStyleToContainers rPr =
classContainers = case rStyle rPr of classContainers = case rStyle rPr of
Nothing -> [] Nothing -> []
Just s -> spanClassToContainers s Just s -> spanClassToContainers s
formatters = map Container $ mapMaybe id formatters = map Container $ mapMaybe id
[ if isBold rPr then (Just Strong) else Nothing [ if isBold rPr then (Just Strong) else Nothing
, if isItalic rPr then (Just Emph) else Nothing , if isItalic rPr then (Just Emph) else Nothing
@ -188,7 +188,7 @@ parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` blockQuoteDivs =
parStyleToContainers pPr | (_:cs) <- pStyle pPr = parStyleToContainers pPr | (_:cs) <- pStyle pPr =
let pPr' = pPr { pStyle = cs} let pPr' = pPr { pStyle = cs}
in in
parStyleToContainers pPr' parStyleToContainers pPr'
parStyleToContainers pPr | null (pStyle pPr), parStyleToContainers pPr | null (pStyle pPr),
Just left <- indentation pPr >>= leftParIndent, Just left <- indentation pPr >>= leftParIndent,
Just hang <- indentation pPr >>= hangingParIndent = Just hang <- indentation pPr >>= hangingParIndent =
@ -205,7 +205,7 @@ parStyleToContainers pPr | null (pStyle pPr),
True -> (Container BlockQuote) : (parStyleToContainers pPr') True -> (Container BlockQuote) : (parStyleToContainers pPr')
False -> parStyleToContainers pPr' False -> parStyleToContainers pPr'
parStyleToContainers _ = [] parStyleToContainers _ = []
strToInlines :: String -> [Inline] strToInlines :: String -> [Inline]
strToInlines = toList . text strToInlines = toList . text
@ -258,9 +258,9 @@ runToInlines (Run rs runElems)
| otherwise = | otherwise =
return $ return $
rebuild (runStyleToContainers rs) (concatMap runElemToInlines runElems) rebuild (runStyleToContainers rs) (concatMap runElemToInlines runElems)
runToInlines (Footnote bps) = runToInlines (Footnote bps) =
concatMapM bodyPartToBlocks bps >>= (\blks -> return [Note blks]) concatMapM bodyPartToBlocks bps >>= (\blks -> return [Note blks])
runToInlines (Endnote bps) = runToInlines (Endnote bps) =
concatMapM bodyPartToBlocks bps >>= (\blks -> return [Note blks]) concatMapM bodyPartToBlocks bps >>= (\blks -> return [Note blks])
makeDataUrl :: String -> B.ByteString -> Maybe String makeDataUrl :: String -> B.ByteString -> Maybe String
@ -343,7 +343,7 @@ oMathElemToTexString (Bar style base) = do
Top -> printf "\\overline{%s}" baseString Top -> printf "\\overline{%s}" baseString
Bottom -> printf "\\underline{%s}" baseString Bottom -> printf "\\underline{%s}" baseString
oMathElemToTexString (Box base) = baseToTexString base oMathElemToTexString (Box base) = baseToTexString base
oMathElemToTexString (BorderBox base) = oMathElemToTexString (BorderBox base) =
baseToTexString base >>= (\s -> return $ printf "\\boxed{%s}" s) baseToTexString base >>= (\s -> return $ printf "\\boxed{%s}" s)
oMathElemToTexString (Delimiter dPr bases) = do oMathElemToTexString (Delimiter dPr bases) = do
let beg = fromMaybe '(' (delimBegChar dPr) let beg = fromMaybe '(' (delimBegChar dPr)
@ -474,7 +474,7 @@ oMathElemToTexString (OMathRun _ run) = return $ stringToTex $ runToString run
baseToTexString :: Base -> DocxContext String baseToTexString :: Base -> DocxContext String
baseToTexString (Base mathElems) = baseToTexString (Base mathElems) =
concatMapM oMathElemToTexString mathElems concatMapM oMathElemToTexString mathElems
isAnchorSpan :: Inline -> Bool isAnchorSpan :: Inline -> Bool
isAnchorSpan (Span (ident, classes, kvs) ils) = isAnchorSpan (Span (ident, classes, kvs) ils) =
@ -535,7 +535,7 @@ bodyPartToBlocks (Paragraph pPr parparts)
let let
otherConts = filter (not . isBlockCodeContainer) (parStyleToContainers pPr) otherConts = filter (not . isBlockCodeContainer) (parStyleToContainers pPr)
in in
return $ return $
rebuild rebuild
otherConts otherConts
[CodeBlock ("", [], []) (concatMap parPartToString parparts)] [CodeBlock ("", [], []) (concatMap parPartToString parparts)]
@ -582,7 +582,7 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
hdrCells <- case hdr of hdrCells <- case hdr of
Just r' -> rowToBlocksList r' Just r' -> rowToBlocksList r'
Nothing -> return [] Nothing -> return []
cells <- mapM rowToBlocksList rows cells <- mapM rowToBlocksList rows
let size = case null hdrCells of let size = case null hdrCells of

View file

@ -121,7 +121,7 @@ handleListParagraphs (
in in
handleListParagraphs ((Div attr1 (blks1 ++ [newDiv2])) : blks) handleListParagraphs ((Div attr1 (blks1 ++ [newDiv2])) : blks)
handleListParagraphs (blk:blks) = blk : (handleListParagraphs blks) handleListParagraphs (blk:blks) = blk : (handleListParagraphs blks)
separateBlocks' :: Block -> [[Block]] -> [[Block]] separateBlocks' :: Block -> [[Block]] -> [[Block]]
separateBlocks' blk ([] : []) = [[blk]] separateBlocks' blk ([] : []) = [[blk]]
separateBlocks' b@(BulletList _) acc = (init acc) ++ [(last acc) ++ [b]] separateBlocks' b@(BulletList _) acc = (init acc) ++ [(last acc) ++ [b]]
@ -139,7 +139,7 @@ flatToBullets' :: Integer -> [Block] -> [Block]
flatToBullets' _ [] = [] flatToBullets' _ [] = []
flatToBullets' num xs@(b : elems) flatToBullets' num xs@(b : elems)
| getLevelN b == num = b : (flatToBullets' num elems) | getLevelN b == num = b : (flatToBullets' num elems)
| otherwise = | otherwise =
let bNumId = getNumIdN b let bNumId = getNumIdN b
bLevel = getLevelN b bLevel = getLevelN b
(children, remaining) = (children, remaining) =
@ -162,7 +162,7 @@ flatToBullets elems = flatToBullets' (-1) elems
blocksToBullets :: [Block] -> [Block] blocksToBullets :: [Block] -> [Block]
blocksToBullets blks = blocksToBullets blks =
bottomUp removeListDivs $ bottomUp removeListDivs $
flatToBullets $ (handleListParagraphs blks) flatToBullets $ (handleListParagraphs blks)
plainParaInlines :: Block -> [Inline] plainParaInlines :: Block -> [Inline]
@ -216,12 +216,12 @@ removeListDivs' blk = [blk]
removeListDivs :: [Block] -> [Block] removeListDivs :: [Block] -> [Block]
removeListDivs = concatMap removeListDivs' removeListDivs = concatMap removeListDivs'
blocksToDefinitions :: [Block] -> [Block] blocksToDefinitions :: [Block] -> [Block]
blocksToDefinitions = blocksToDefinitions' [] [] blocksToDefinitions = blocksToDefinitions' [] []

View file

@ -106,7 +106,7 @@ type NameSpaces = [(String, String)]
data Docx = Docx Document data Docx = Docx Document
deriving Show deriving Show
data Document = Document NameSpaces Body data Document = Document NameSpaces Body
deriving Show deriving Show
data Body = Body [BodyPart] data Body = Body [BodyPart]
@ -276,7 +276,7 @@ defaultRunStyle = RunStyle { isBold = False
, isSubScript = False , isSubScript = False
, rUnderline = Nothing , rUnderline = Nothing
, rStyle = Nothing , rStyle = Nothing
} }
type Target = String type Target = String
@ -286,7 +286,7 @@ type BookMarkId = String
type RelId = String type RelId = String
type ChangeId = String type ChangeId = String
type Author = String type Author = String
type ChangeDate = String type ChangeDate = String
attrToNSPair :: Attr -> Maybe (String, String) attrToNSPair :: Attr -> Maybe (String, String)
attrToNSPair (Attr (QName s _ (Just "xmlns")) val) = Just (s, val) attrToNSPair (Attr (QName s _ (Just "xmlns")) val) = Just (s, val)
@ -301,18 +301,18 @@ archiveToDocx archive = do
rEnv = ReaderEnv notes numbering rels media rEnv = ReaderEnv notes numbering rels media
doc <- runD (archiveToDocument archive) rEnv doc <- runD (archiveToDocument archive) rEnv
return $ Docx doc return $ Docx doc
archiveToDocument :: Archive -> D Document archiveToDocument :: Archive -> D Document
archiveToDocument zf = do archiveToDocument zf = do
entry <- maybeToD $ findEntryByPath "word/document.xml" zf entry <- maybeToD $ findEntryByPath "word/document.xml" zf
docElem <- maybeToD $ (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry docElem <- maybeToD $ (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry
let namespaces = mapMaybe attrToNSPair (elAttribs docElem) let namespaces = mapMaybe attrToNSPair (elAttribs docElem)
bodyElem <- maybeToD $ findChild (elemName namespaces "w" "body") docElem bodyElem <- maybeToD $ findChild (elemName namespaces "w" "body") docElem
body <- elemToBody namespaces bodyElem body <- elemToBody namespaces bodyElem
return $ Document namespaces body return $ Document namespaces body
elemToBody :: NameSpaces -> Element -> D Body elemToBody :: NameSpaces -> Element -> D Body
elemToBody ns element | isElem ns "w" "body" element = elemToBody ns element | isElem ns "w" "body" element =
mapD (elemToBodyPart ns) (elChildren element) >>= mapD (elemToBodyPart ns) (elChildren element) >>=
(\bps -> return $ Body bps) (\bps -> return $ Body bps)
@ -349,10 +349,10 @@ relElemToRelationship element | qName (elName element) == "Relationship" =
target <- findAttr (QName "Target" Nothing Nothing) element target <- findAttr (QName "Target" Nothing Nothing) element
return $ Relationship (relId, target) return $ Relationship (relId, target)
relElemToRelationship _ = Nothing relElemToRelationship _ = Nothing
archiveToRelationships :: Archive -> [Relationship] archiveToRelationships :: Archive -> [Relationship]
archiveToRelationships archive = archiveToRelationships archive =
let relPaths = filter filePathIsRel (filesInArchive archive) let relPaths = filter filePathIsRel (filesInArchive archive)
entries = mapMaybe (\f -> findEntryByPath f archive) relPaths entries = mapMaybe (\f -> findEntryByPath f archive) relPaths
relElems = mapMaybe (parseXMLDoc . UTF8.toStringLazy . fromEntry) entries relElems = mapMaybe (parseXMLDoc . UTF8.toStringLazy . fromEntry) entries
@ -445,7 +445,7 @@ archiveToNumbering archive =
elemToNotes :: NameSpaces -> String -> Element -> Maybe (M.Map String Element) elemToNotes :: NameSpaces -> String -> Element -> Maybe (M.Map String Element)
elemToNotes ns notetype element elemToNotes ns notetype element
| isElem ns "w" (notetype ++ "s") element = | isElem ns "w" (notetype ++ "s") element =
let pairs = mapMaybe let pairs = mapMaybe
(\e -> findAttr (elemName ns "w" "id") e >>= (\e -> findAttr (elemName ns "w" "id") e >>=
(\a -> Just (a, e))) (\a -> Just (a, e)))
@ -478,7 +478,7 @@ elemToTblLook :: NameSpaces -> Element -> D TblLook
elemToTblLook ns element | isElem ns "w" "tblLook" element = elemToTblLook ns element | isElem ns "w" "tblLook" element =
let firstRow = findAttr (elemName ns "w" "firstRow") element let firstRow = findAttr (elemName ns "w" "firstRow") element
val = findAttr (elemName ns "w" "val") element val = findAttr (elemName ns "w" "val") element
firstRowFmt = firstRowFmt =
case firstRow of case firstRow of
Just "1" -> True Just "1" -> True
Just _ -> False Just _ -> False
@ -505,15 +505,15 @@ elemToCell ns element | isElem ns "w" "tc" element =
elemToCell _ _ = throwError WrongElem elemToCell _ _ = throwError WrongElem
elemToParIndentation :: NameSpaces -> Element -> Maybe ParIndentation elemToParIndentation :: NameSpaces -> Element -> Maybe ParIndentation
elemToParIndentation ns element | isElem ns "w" "ind" element = elemToParIndentation ns element | isElem ns "w" "ind" element =
Just $ ParIndentation { Just $ ParIndentation {
leftParIndent = leftParIndent =
findAttr (QName "left" (lookup "w" ns) (Just "w")) element >>= findAttr (QName "left" (lookup "w" ns) (Just "w")) element >>=
stringToInteger stringToInteger
, rightParIndent = , rightParIndent =
findAttr (QName "right" (lookup "w" ns) (Just "w")) element >>= findAttr (QName "right" (lookup "w" ns) (Just "w")) element >>=
stringToInteger stringToInteger
, hangingParIndent = , hangingParIndent =
findAttr (QName "hanging" (lookup "w" ns) (Just "w")) element >>= findAttr (QName "hanging" (lookup "w" ns) (Just "w")) element >>=
stringToInteger} stringToInteger}
elemToParIndentation _ _ = Nothing elemToParIndentation _ _ = Nothing
@ -558,7 +558,7 @@ elemToBodyPart ns element
case lookupLevel numId lvl num of case lookupLevel numId lvl num of
Just levelInfo -> return $ ListItem parstyle numId lvl levelInfo parparts Just levelInfo -> return $ ListItem parstyle numId lvl levelInfo parparts
Nothing -> throwError WrongElem Nothing -> throwError WrongElem
elemToBodyPart ns element elemToBodyPart ns element
| isElem ns "w" "p" element = do | isElem ns "w" "p" element = do
let parstyle = elemToParagraphStyle ns element let parstyle = elemToParagraphStyle ns element
parparts <- mapD (elemToParPart ns) (elChildren element) parparts <- mapD (elemToParPart ns) (elChildren element)
@ -667,15 +667,15 @@ elemToMathElem ns element | isElem ns "m" "bar" element = do
base <-maybeToD (findChild (QName "e" (lookup "m" ns) (Just "m")) element) >>= base <-maybeToD (findChild (QName "e" (lookup "m" ns) (Just "m")) element) >>=
elemToBase ns elemToBase ns
return $ Bar barPr base return $ Bar barPr base
elemToMathElem ns element | isElem ns "m" "box" element = elemToMathElem ns element | isElem ns "m" "box" element =
maybeToD (findChild (elemName ns "m" "e") element) >>= maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns >>= elemToBase ns >>=
(\b -> return $ Box b) (\b -> return $ Box b)
elemToMathElem ns element | isElem ns "m" "borderBox" element = elemToMathElem ns element | isElem ns "m" "borderBox" element =
maybeToD (findChild (elemName ns "m" "e") element) >>= maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns >>= elemToBase ns >>=
(\b -> return $ BorderBox b) (\b -> return $ BorderBox b)
elemToMathElem ns element | isElem ns "m" "d" element = elemToMathElem ns element | isElem ns "m" "d" element =
let style = elemToDelimStyle ns element let style = elemToDelimStyle ns element
in in
mapD (elemToBase ns) (elChildren element) >>= mapD (elemToBase ns) (elChildren element) >>=
@ -684,8 +684,8 @@ elemToMathElem ns element | isElem ns "m" "eqArr" element =
mapD (elemToBase ns) (elChildren element) >>= mapD (elemToBase ns) (elChildren element) >>=
(\es -> return $ EquationArray es) (\es -> return $ EquationArray es)
elemToMathElem ns element | isElem ns "m" "f" element = do elemToMathElem ns element | isElem ns "m" "f" element = do
num <- maybeToD $ findChild (elemName ns "m" "num") element num <- maybeToD $ findChild (elemName ns "m" "num") element
den <- maybeToD $ findChild (elemName ns "m" "den") element den <- maybeToD $ findChild (elemName ns "m" "den") element
numElems <- mapD (elemToMathElem ns) (elChildren num) numElems <- mapD (elemToMathElem ns) (elChildren num)
denElems <- mapD (elemToMathElem ns) (elChildren den) denElems <- mapD (elemToMathElem ns) (elChildren den)
return $ Fraction numElems denElems return $ Fraction numElems denElems
@ -695,7 +695,7 @@ elemToMathElem ns element | isElem ns "m" "func" element = do
elemToBase ns elemToBase ns
fnElems <- mapD (elemToMathElem ns) (elChildren fName) fnElems <- mapD (elemToMathElem ns) (elChildren fName)
return $ Function fnElems base return $ Function fnElems base
elemToMathElem ns element | isElem ns "m" "groupChr" element = elemToMathElem ns element | isElem ns "m" "groupChr" element =
let style = elemToGroupStyle ns element let style = elemToGroupStyle ns element
in in
maybeToD (findChild (elemName ns "m" "e") element) >>= maybeToD (findChild (elemName ns "m" "e") element) >>=
@ -920,11 +920,11 @@ elemToRunElems ns element
elemToRunElems _ _ = throwError WrongElem elemToRunElems _ _ = throwError WrongElem

View file

@ -90,7 +90,7 @@ combineReducibles r s =
True -> case (not . null) rs && isSpace (last rs) of True -> case (not . null) rs && isSpace (last rs) of
True -> rebuild conts (init rs) ++ [last rs, s] True -> rebuild conts (init rs) ++ [last rs, s]
False -> [r,s] False -> [r,s]
False -> rebuild False -> rebuild
shared $ shared $
reduceList $ reduceList $
(rebuild remaining rs) ++ (rebuild remaining' ss) (rebuild remaining rs) ++ (rebuild remaining' ss)
@ -145,7 +145,7 @@ instance Reducible Inline where
isSpace _ = False isSpace _ = False
instance Reducible Block where instance Reducible Block where
(Div (ident, classes, kvs) blks) <++> blk | "list-item" `elem` classes = (Div (ident, classes, kvs) blks) <++> blk | "list-item" `elem` classes =
[Div (ident, classes, kvs) (reduceList blks), blk] [Div (ident, classes, kvs) (reduceList blks), blk]
blk <++> blk' = combineReducibles blk blk' blk <++> blk' = combineReducibles blk blk'
@ -177,5 +177,5 @@ rebuild :: [Container a] -> [a] -> [a]
rebuild [] xs = xs rebuild [] xs = xs
rebuild ((Container f) : cs) xs = rebuild cs $ [f xs] rebuild ((Container f) : cs) xs = rebuild cs $ [f xs]
rebuild (NullContainer : cs) xs = rebuild cs $ xs rebuild (NullContainer : cs) xs = rebuild cs $ xs

View file

@ -4382,5 +4382,5 @@ uniconvMap = M.fromList [ ('\8193', "\\quad")
-- , ('\120829', "\\mttseven") -- , ('\120829', "\\mttseven")
-- , ('\120830', "\\mtteight") -- , ('\120830', "\\mtteight")
-- , ('\120831', "\\mttnine") -- , ('\120831', "\\mttnine")
-- ] -- ]

View file

@ -335,10 +335,10 @@ isSpaceOrEmpty (Str "") = True
isSpaceOrEmpty _ = False isSpaceOrEmpty _ = False
-- | Extract the leading and trailing spaces from inside an inline element -- | Extract the leading and trailing spaces from inside an inline element
-- and place them outside the element. -- and place them outside the element.
extractSpaces :: (Inlines -> Inlines) -> Inlines -> Inlines extractSpaces :: (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces f is = extractSpaces f is =
let contents = B.unMany is let contents = B.unMany is
left = case viewl contents of left = case viewl contents of
(Space :< _) -> B.space (Space :< _) -> B.space

View file

@ -142,10 +142,10 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do
let len = offset contents let len = offset contents
-- ident seem to be empty most of the time and asciidoc will generate them automatically -- ident seem to be empty most of the time and asciidoc will generate them automatically
-- so lets make them not show up when null -- so lets make them not show up when null
let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]")
let setext = writerSetextHeaders opts let setext = writerSetextHeaders opts
return $ return $
(if setext (if setext
then then
identifier $$ contents $$ identifier $$ contents $$
(case level of (case level of
@ -155,7 +155,7 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do
4 -> text $ replicate len '+' 4 -> text $ replicate len '+'
_ -> empty) <> blankline _ -> empty) <> blankline
else else
identifier $$ text (replicate level '=') <> space <> contents <> blankline) identifier $$ text (replicate level '=') <> space <> contents <> blankline)
blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $
flush (attrs <> dashes <> space <> attrs <> cr <> text str <> flush (attrs <> dashes <> space <> attrs <> cr <> text str <>
cr <> dashes) <> blankline cr <> dashes) <> blankline

View file

@ -42,7 +42,7 @@ type WS a = State WriterState a
defaultWriterState :: WriterState defaultWriterState :: WriterState
defaultWriterState = WriterState{ defaultWriterState = WriterState{
blockStyles = Set.empty blockStyles = Set.empty
, inlineStyles = Set.empty , inlineStyles = Set.empty
, links = [] , links = []
, listDepth = 1 , listDepth = 1
@ -267,7 +267,7 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs
$ inTags False "BorderColor" [("type","enumeration")] (text "Black") $ inTags False "BorderColor" [("type","enumeration")] (text "Black")
$$ (inTags False "Destination" [("type","object")] $$ (inTags False "Destination" [("type","object")]
$ text $ "HyperlinkURLDestination/"++(escapeStringForXML url)) $ text $ "HyperlinkURLDestination/"++(escapeStringForXML url))
-- | Convert a list of Pandoc blocks to ICML. -- | Convert a list of Pandoc blocks to ICML.
blocksToICML :: WriterOptions -> Style -> [Block] -> WS Doc blocksToICML :: WriterOptions -> Style -> [Block] -> WS Doc
@ -352,7 +352,7 @@ listItemsToICML opts listType style attribs (first:rest) = do
-- | Convert a list of blocks to ICML list items. -- | Convert a list of blocks to ICML list items.
listItemToICML :: WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS Doc listItemToICML :: WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS Doc
listItemToICML opts style isFirst attribs item = listItemToICML opts style isFirst attribs item =
let makeNumbStart (Just (beginsWith, numbStl, _)) = let makeNumbStart (Just (beginsWith, numbStl, _)) =
let doN DefaultStyle = [] let doN DefaultStyle = []
doN LowerRoman = [lowerRomanName] doN LowerRoman = [lowerRomanName]
doN UpperRoman = [upperRomanName] doN UpperRoman = [upperRomanName]
@ -467,7 +467,7 @@ parStyle opts style lst =
-- | Wrap a Doc in an ICML Character Style. -- | Wrap a Doc in an ICML Character Style.
charStyle :: Style -> Doc -> WS Doc charStyle :: Style -> Doc -> WS Doc
charStyle style content = charStyle style content =
let (stlStr, attrs) = styleToStrAttr style let (stlStr, attrs) = styleToStrAttr style
doc = inTags True "CharacterStyleRange" attrs $ inTagsSimple "Content" $ flush content doc = inTags True "CharacterStyleRange" attrs $ inTagsSimple "Content" $ flush content
in do in do

View file

@ -504,7 +504,7 @@ paraStyle parent attrs = do
tight = if t then [ ("fo:margin-top" , "0in" ) tight = if t then [ ("fo:margin-top" , "0in" )
, ("fo:margin-bottom" , "0in" )] , ("fo:margin-bottom" , "0in" )]
else [] else []
indent = if (i /= 0 || b) indent = if (i /= 0 || b)
then [ ("fo:margin-left" , indentVal) then [ ("fo:margin-left" , indentVal)
, ("fo:margin-right" , "0in" ) , ("fo:margin-right" , "0in" )
, ("fo:text-indent" , "0in" ) , ("fo:text-indent" , "0in" )
@ -534,7 +534,7 @@ paraTableStyles t s (a:xs)
[ ("fo:text-align", x) [ ("fo:text-align", x)
, ("style:justify-single-word", "false")] , ("style:justify-single-word", "false")]
data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC | Pre data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC | Pre
deriving ( Eq,Ord ) deriving ( Eq,Ord )
textStyleAttr :: TextStyle -> [(String,String)] textStyleAttr :: TextStyle -> [(String,String)]

View file

@ -174,7 +174,7 @@ blockToRST (Para [Image txt (src,'f':'i':'g':':':tit)]) = do
let alt = ":alt: " <> if null tit then capt else text tit let alt = ":alt: " <> if null tit then capt else text tit
return $ hang 3 ".. " $ fig $$ alt $+$ capt $$ blankline return $ hang 3 ".. " $ fig $$ alt $+$ capt $$ blankline
blockToRST (Para inlines) blockToRST (Para inlines)
| LineBreak `elem` inlines = do -- use line block if LineBreaks | LineBreak `elem` inlines = do -- use line block if LineBreaks
lns <- mapM inlineListToRST $ splitBy (==LineBreak) inlines lns <- mapM inlineListToRST $ splitBy (==LineBreak) inlines
return $ (vcat $ map (text "| " <>) lns) <> blankline return $ (vcat $ map (text "| " <>) lns) <> blankline
| otherwise = do | otherwise = do