diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Parsing.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/HTML.hs | 34 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/LaTeX.hs | 45 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 52 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/RST.hs | 18 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 11 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 15 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 19 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Org.hs | 63 |
9 files changed, 158 insertions, 101 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 9ed18d4e0..2543f11f0 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -838,7 +838,7 @@ blankLineBlockLine = try (char '|' >> blankline) lineBlockLines :: Monad m => ParserT [Char] st m [String] lineBlockLines = try $ do lines' <- many1 (lineBlockLine <|> ((:[]) <$> blankLineBlockLine)) - skipMany1 $ blankline <|> blankLineBlockLine + skipMany $ blankline return lines' -- | Parse a table using 'headerParser', 'rowParser', diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index d85488478..2093be19c 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -58,7 +58,7 @@ import Data.Maybe ( fromMaybe, isJust, isNothing ) import Data.List.Split ( wordsBy ) import Data.List ( intercalate, isPrefixOf ) import Data.Char ( isDigit, isLetter, isAlphaNum ) -import Control.Monad ( guard, mzero, void, unless, mplus ) +import Control.Monad ( guard, mzero, void, unless, mplus, msum ) import Control.Arrow ((***)) import Control.Applicative ( (<|>) ) import Data.Monoid (First (..)) @@ -576,23 +576,23 @@ pPara = do return $ B.para contents pFigure :: PandocMonad m => TagParser m Blocks -pFigure = do +pFigure = try $ do TagOpen _ _ <- pSatisfy (matchTagOpen "figure" []) skipMany pBlank - let pImg = pOptInTag "p" pImage <* skipMany pBlank - pCapt = option mempty $ pInTags "figcaption" inline <* skipMany pBlank - pImgCapt = do - img <- pImg - cap <- pCapt - return (img, cap) - pCaptImg = do - cap <- pCapt - img <- pImg - return (img, cap) - (imgMany, caption) <- pImgCapt <|> pCaptImg + let pImg = (\x -> (Just x, Nothing)) <$> + (pOptInTag "p" pImage <* skipMany pBlank) + pCapt = (\x -> (Nothing, Just x)) <$> + (pInTags "figcaption" inline <* skipMany pBlank) + pSkip = (Nothing, Nothing) <$ pSatisfy (not . matchTagClose "figure") + res <- many (pImg <|> pCapt <|> pSkip) + let mbimg = msum $ map fst res + let mbcap = msum $ map snd res TagClose _ <- pSatisfy (matchTagClose "figure") - let (Image attr _ (url, tit)):_ = B.toList imgMany - return $ B.para $ B.imageWith attr url ("fig:" ++ tit) caption + let caption = fromMaybe mempty mbcap + case B.toList <$> mbimg of + Just [Image attr _ (url, tit)] -> + return $ B.para $ B.imageWith attr url ("fig:" ++ tit) caption + _ -> mzero pCodeBlock :: PandocMonad m => TagParser m Blocks pCodeBlock = try $ do @@ -961,7 +961,7 @@ blockHtmlTags = Set.fromList "dir", "div", "dl", "dt", "fieldset", "figcaption", "figure", "footer", "form", "h1", "h2", "h3", "h4", "h5", "h6", "head", "header", "hgroup", "hr", "html", - "isindex", "main", "menu", "noframes", "ol", "output", "p", "pre", + "isindex", "main", "menu", "meta", "noframes", "ol", "output", "p", "pre", "section", "table", "tbody", "textarea", "thead", "tfoot", "ul", "dd", "dt", "frameset", "li", "tbody", "td", "tfoot", @@ -1048,7 +1048,7 @@ x `closes` "p" | x `elem` ["address", "article", "aside", "blockquote", "dir", "div", "dl", "fieldset", "footer", "form", "h1", "h2", "h3", "h4", "h5", "h6", "header", "hr", "main", "menu", "nav", "ol", "p", "pre", "section", "table", "ul"] = True -"meta" `closes` "meta" = True +_ `closes` "meta" = True "form" `closes` "form" = True "label" `closes` "label" = True "map" `closes` "map" = True diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 06e112cef..d0e95bd85 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -770,11 +770,13 @@ keyval = try $ do keyvals :: PandocMonad m => LP m [(String, String)] keyvals = try $ symbol '[' >> manyTill keyval (symbol ']') -accent :: (Char -> String) -> Inlines -> LP m Inlines -accent f ils = +accent :: PandocMonad m => Char -> (Char -> String) -> LP m Inlines +accent c f = try $ do + ils <- tok case toList ils of (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys) - [] -> mzero + [Space] -> return $ str [c] + [] -> return $ str [c] _ -> return ils grave :: Char -> String @@ -961,6 +963,19 @@ hacek 'Z' = "Ž" hacek 'z' = "ž" hacek c = [c] +ogonek :: Char -> String +ogonek 'a' = "ą" +ogonek 'e' = "ę" +ogonek 'o' = "ǫ" +ogonek 'i' = "į" +ogonek 'u' = "ų" +ogonek 'A' = "Ą" +ogonek 'E' = "Ę" +ogonek 'I' = "Į" +ogonek 'O' = "Ǫ" +ogonek 'U' = "Ų" +ogonek c = [c] + breve :: Char -> String breve 'A' = "Ă" breve 'a' = "ă" @@ -1275,17 +1290,19 @@ inlineCommands = M.fromList $ , ("copyright", lit "©") , ("textasciicircum", lit "^") , ("textasciitilde", lit "~") - , ("H", try $ tok >>= accent hungarumlaut) - , ("`", option (str "`") $ try $ tok >>= accent grave) - , ("'", option (str "'") $ try $ tok >>= accent acute) - , ("^", option (str "^") $ try $ tok >>= accent circ) - , ("~", option (str "~") $ try $ tok >>= accent tilde) - , ("\"", option (str "\"") $ try $ tok >>= accent umlaut) - , (".", option (str ".") $ try $ tok >>= accent dot) - , ("=", option (str "=") $ try $ tok >>= accent macron) - , ("c", option (str "c") $ try $ tok >>= accent cedilla) - , ("v", option (str "v") $ try $ tok >>= accent hacek) - , ("u", option (str "u") $ try $ tok >>= accent breve) + , ("H", accent '\779' hungarumlaut) + , ("`", accent '`' grave) + , ("'", accent '\'' acute) + , ("^", accent '^' circ) + , ("~", accent '~' tilde) + , ("\"", accent '\776' umlaut) + , (".", accent '\775' dot) + , ("=", accent '\772' macron) + , ("c", accent '\807' cedilla) + , ("v", accent 'ˇ' hacek) + , ("u", accent '\774' breve) + , ("k", accent '\808' ogonek) + , ("textogonekcentered", accent '\808' ogonek) , ("i", lit "i") , ("\\", linebreak <$ (do inTableCell <- sInTableCell <$> getState guard $ not inTableCell diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 77f75c8c6..2454057fa 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {- Copyright (C) 2017 Alexander Krotov <ilabdsf@gmail.com> @@ -32,7 +33,6 @@ TODO: - {{{ }}} syntax for <example> - Page breaks (five "*") - Headings with anchors (make it round trip with Muse writer) -- Verse markup (">") - Org tables - table.el tables - Images with attributes (floating and width) @@ -101,6 +101,9 @@ parseBlocks = do -- utility functions -- +eol :: Stream s m Char => ParserT s st m () +eol = void newline <|> eof + nested :: PandocMonad m => MuseParser m a -> MuseParser m a nested p = do nestlevel <- stateMaxNestingLevel <$> getState @@ -180,7 +183,9 @@ blockElements = choice [ comment , centerTag , rightTag , quoteTag + , divTag , verseTag + , lineBlock , bulletList , orderedList , definitionList @@ -194,7 +199,7 @@ comment = try $ do char ';' space many $ noneOf "\n" - void newline <|> eof + eol return mempty separator :: PandocMonad m => MuseParser m (F Blocks) @@ -202,7 +207,7 @@ separator = try $ do string "----" many $ char '-' many spaceChar - void newline <|> eof + eol return $ return B.horizontalRule header :: PandocMonad m => MuseParser m (F Blocks) @@ -212,8 +217,8 @@ header = try $ do getPosition >>= \pos -> guard (st == NullState && q == NoQuote && sourceColumn pos == 1) level <- liftM length $ many1 $ char '*' guard $ level <= 5 - skipSpaces - content <- trimInlinesF . mconcat <$> manyTill inline newline + spaceChar + content <- trimInlinesF . mconcat <$> manyTill inline eol attr <- registerHeader ("", [], []) (runF content defaultParserState) return $ B.headerWith attr level <$> content @@ -245,6 +250,12 @@ rightTag = blockTag id "right" quoteTag :: PandocMonad m => MuseParser m (F Blocks) quoteTag = withQuoteContext InDoubleQuote $ blockTag B.blockQuote "quote" +-- <div> tag is supported by Emacs Muse, but not Amusewiki 2.025 +divTag :: PandocMonad m => MuseParser m (F Blocks) +divTag = do + (attrs, content) <- parseHtmlContentWithAttrs "div" block + return $ (B.divWith attrs) <$> mconcat content + verseLine :: PandocMonad m => MuseParser m String verseLine = do line <- anyLine <|> many1Till anyChar eof @@ -261,8 +272,7 @@ verseLines = do verseTag :: PandocMonad m => MuseParser m (F Blocks) verseTag = do (_, content) <- htmlElement "verse" - parsedContent <- parseFromString verseLines content - return parsedContent + parseFromString verseLines content commentTag :: PandocMonad m => MuseParser m (F Blocks) commentTag = parseHtmlContent "comment" anyChar >> return mempty @@ -300,6 +310,26 @@ noteBlock = try $ do many1Till block (eof <|> () <$ lookAhead noteMarker) -- +-- Verse markup +-- + +lineVerseLine :: PandocMonad m => MuseParser m String +lineVerseLine = try $ do + char '>' + white <- many1 (char ' ' >> pure '\160') + rest <- anyLine + return $ tail white ++ rest + +blanklineVerseLine :: PandocMonad m => MuseParser m Char +blanklineVerseLine = try $ char '>' >> blankline + +lineBlock :: PandocMonad m => MuseParser m (F Blocks) +lineBlock = try $ do + lns <- many1 (pure <$> blanklineVerseLine <|> lineVerseLine) + lns' <- mapM (parseFromString' (trimInlinesF . mconcat <$> many inline)) lns + return $ B.lineBlock <$> sequence lns' + +-- -- lists -- @@ -379,8 +409,8 @@ definitionListItem = try $ do pure $ do lineContent' <- lineContent pure (B.text term, [lineContent']) where - termParser = (many1 spaceChar) >> -- Initial space as required by Amusewiki, but not Emacs Muse - (many1Till anyChar $ lookAhead (void (try (spaceChar >> string "::")) <|> void newline)) + termParser = many1 spaceChar >> -- Initial space as required by Amusewiki, but not Emacs Muse + many1Till anyChar (lookAhead (void (try (spaceChar >> string "::")) <|> void newline)) endOfInput = try $ skipMany blankline >> skipSpaces >> eof twoBlankLines = try $ blankline >> skipMany1 blankline newDefinitionListItem = try $ void termParser @@ -438,10 +468,10 @@ museAppendElement tbl element = tableCell :: PandocMonad m => MuseParser m (F Blocks) tableCell = try $ liftM B.plain . trimInlinesF . mconcat <$> manyTill inline (lookAhead cellEnd) - where cellEnd = try $ void (many1 spaceChar >> char '|') <|> void newline <|> eof + where cellEnd = try $ void (many1 spaceChar >> char '|') <|> eol tableElements :: PandocMonad m => MuseParser m [MuseTableElement] -tableElements = tableParseElement `sepEndBy1` (void newline <|> eof) +tableElements = tableParseElement `sepEndBy1` eol elementsToTable :: [MuseTableElement] -> F MuseTable elementsToTable = foldM museAppendElement emptyTable diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 190b065fb..daaeff2f0 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -219,7 +219,6 @@ block = choice [ codeBlock , directive , anchor , comment - , include , header , hrule , lineBlock -- must go before definitionList @@ -460,16 +459,16 @@ tab-width encoding -} -include :: PandocMonad m => RSTParser m Blocks -include = try $ do - string ".. include::" - skipMany spaceChar - f <- trim <$> anyLine - fields <- many $ rawFieldListItem 3 +includeDirective :: PandocMonad m + => String -> [(String, String)] -> String + -> RSTParser m Blocks +includeDirective top fields body = do + let f = trim top + guard $ not (null f) + guard $ null (trim body) -- options let (startLine :: Maybe Int) = lookup "start-line" fields >>= safeRead let (endLine :: Maybe Int) = lookup "end-line" fields >>= safeRead - guard $ not (null f) oldPos <- getPosition oldInput <- getInput containers <- stateContainers <$> getState @@ -501,7 +500,7 @@ include = try $ do Just patt -> drop 1 . dropWhile (not . (patt `isInfixOf`)) Nothing -> id) $ contentLines' - let contents' = unlines contentLines'' + let contents' = unlines contentLines'' ++ "\n" case lookup "code" fields of Just lang -> do let numberLines = lookup "number-lines" fields @@ -687,6 +686,7 @@ directive' = do $ lookup "height" fields >>= (lengthToDim . filter (not . isSpace)) case label of + "include" -> includeDirective top fields body' "table" -> tableDirective top fields body' "list-table" -> listTableDirective top fields body' "csv-table" -> csvTableDirective top fields body' diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 9ac37a0ba..1641b991c 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -47,7 +47,7 @@ import Control.Monad.State.Strict import Data.Char (ord, toLower) import Data.Text (Text) import qualified Data.Text.Lazy as TL -import Data.List (intersperse, isPrefixOf) +import Data.List (intersperse, isPrefixOf, partition, intercalate) import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing) import Data.Monoid ((<>)) import qualified Data.Set as Set @@ -569,8 +569,15 @@ imgAttrsToHtml opts attr = do isNotDim _ = True dimensionsToAttrList :: Attr -> [(String, String)] -dimensionsToAttrList attr = (go Width) ++ (go Height) +dimensionsToAttrList attr = consolidateStyles $ go Width ++ go Height where + consolidateStyles :: [(String, String)] -> [(String, String)] + consolidateStyles xs = + case partition isStyle xs of + ([], _) -> xs + (ss, rest) -> ("style", intercalate ";" $ map snd ss) : rest + isStyle ("style", _) = True + isStyle _ = False go dir = case (dimension dir attr) of (Just (Pixel a)) -> [(show dir, show a)] (Just x) -> [("style", show dir ++ ":" ++ show x)] diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 4a81cd245..2da087077 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -628,6 +628,7 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do put $ st {stOLLevel = oldlevel + 1} items <- mapM listItemToLaTeX lst modify (\s -> s {stOLLevel = oldlevel}) + let beamer = stBeamer st let tostyle x = case numstyle of Decimal -> "\\arabic" <> braces x UpperRoman -> "\\Roman" <> braces x @@ -641,11 +642,21 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do TwoParens -> parens x Period -> x <> "." _ -> x <> "." + let exemplar = case numstyle of + Decimal -> "1" + UpperRoman -> "I" + LowerRoman -> "i" + UpperAlpha -> "A" + LowerAlpha -> "a" + Example -> "1" + DefaultStyle -> "1" let enum = text $ "enum" ++ map toLower (toRomanNumeral oldlevel) let stylecommand = if numstyle == DefaultStyle && numdelim == DefaultDelim then empty - else "\\def" <> "\\label" <> enum <> - braces (todelim $ tostyle enum) + else if beamer + then brackets (todelim exemplar) + else "\\def" <> "\\label" <> enum <> + braces (todelim $ tostyle enum) let resetcounter = if start == 1 || oldlevel > 4 then empty else "\\setcounter" <> braces enum <> diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 95977ce17..0221ba6ef 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -288,6 +288,7 @@ escapeString opts (c:cs) = | otherwise -> ">" ++ escapeString opts cs _ | c `elem` ['\\','`','*','_','[',']','#'] -> '\\':c:escapeString opts cs + '|' | isEnabled Ext_pipe_tables opts -> '\\':'|':escapeString opts cs '^' | isEnabled Ext_superscript opts -> '\\':'^':escapeString opts cs '~' | isEnabled Ext_subscript opts -> '\\':'~':escapeString opts cs '$' | isEnabled Ext_tex_math_dollars opts -> '\\':'$':escapeString opts cs @@ -787,6 +788,7 @@ blockListToMarkdown :: PandocMonad m -> MD m Doc blockListToMarkdown opts blocks = do inlist <- asks envInList + isPlain <- asks envPlain -- a) insert comment between list and indented code block, or the -- code block will be treated as a list continuation paragraph -- b) change Plain to Para unless it's followed by a RawBlock @@ -813,9 +815,11 @@ blockListToMarkdown opts blocks = do isListBlock (OrderedList _ _) = True isListBlock (DefinitionList _) = True isListBlock _ = False - commentSep = if isEnabled Ext_raw_html opts - then RawBlock "html" "<!-- -->\n" - else RawBlock "markdown" " \n" + commentSep = if isPlain + then Null + else if isEnabled Ext_raw_html opts + then RawBlock "html" "<!-- -->\n" + else RawBlock "markdown" " \n" mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat getKey :: Doc -> Key @@ -931,7 +935,7 @@ avoidBadWrapsInList (s:Str cs:[]) avoidBadWrapsInList (x:xs) = x : avoidBadWrapsInList xs isOrderedListMarker :: String -> Bool -isOrderedListMarker xs = (last xs `elem` ['.',')']) && +isOrderedListMarker xs = not (null xs) && (last xs `elem` ['.',')']) && isRight (runParser (anyOrderedListMarker >> eof) defaultParserState "" xs) @@ -946,11 +950,10 @@ inlineToMarkdown opts (Span attrs ils) = do contents <- inlineListToMarkdown opts ils return $ case plain of True -> contents - False | isEnabled Ext_bracketed_spans opts -> + False | attrs == nullAttr -> contents + | isEnabled Ext_bracketed_spans opts -> "[" <> contents <> "]" <> - if attrs == nullAttr - then "{}" - else linkAttributes opts attrs + linkAttributes opts attrs | isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts -> tagWithAttrs "span" attrs <> contents <> text "</span>" diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 48f17c4fb..88f42acd4 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -129,36 +129,25 @@ blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do blankline $$ contents $$ blankline $$ drawerEndTag $$ blankline -blockToOrg (Div attrs bs) = do +blockToOrg (Div (ident, classes, kv) bs) = do contents <- blockListToOrg bs + -- if one class looks like the name of a greater block then output as such: + -- The ID, if present, is added via the #+NAME keyword; other classes and + -- key-value pairs are kept as #+ATTR_HTML attributes. let isGreaterBlockClass = (`elem` ["center", "quote"]) . map toLower - return $ case attrs of - ("", [], []) -> - -- nullAttr, treat contents as if it wasn't wrapped - blankline $$ contents $$ blankline - (ident, [], []) -> - -- only an id: add id as an anchor, unwrap the rest - blankline $$ "<<" <> text ident <> ">>" $$ contents $$ blankline - (ident, classes, kv) -> - -- if one class looks like the name of a greater block then output as - -- such: The ID, if present, is added via the #+NAME keyword; other - -- classes and key-value pairs are kept as #+ATTR_HTML attributes. - let - (blockTypeCand, classes') = partition isGreaterBlockClass classes - in case blockTypeCand of - (blockType:classes'') -> - blankline $$ attrHtml (ident, classes'' <> classes', kv) $$ - "#+BEGIN_" <> text blockType $$ contents $$ - "#+END_" <> text blockType $$ blankline - _ -> - -- fallback: wrap in div tags - let - startTag = tagWithAttrs "div" attrs - endTag = text "</div>" - in blankline $$ "#+BEGIN_HTML" $$ - nest 2 startTag $$ "#+END_HTML" $$ blankline $$ - contents $$ blankline $$ "#+BEGIN_HTML" $$ - nest 2 endTag $$ "#+END_HTML" $$ blankline + (blockTypeCand, classes') = partition isGreaterBlockClass classes + return $ case blockTypeCand of + (blockType:classes'') -> + blankline $$ attrHtml (ident, classes'' <> classes', kv) $$ + "#+BEGIN_" <> text blockType $$ contents $$ + "#+END_" <> text blockType $$ blankline + _ -> + -- fallback with id: add id as an anchor if present, discard classes and + -- key-value pairs, unwrap the content. + let contents' = if not (null ident) + then "<<" <> text ident <> ">>" $$ contents + else contents + in blankline $$ contents' $$ blankline blockToOrg (Plain inlines) = inlineListToOrg inlines -- title beginning with fig: indicates that the image is a figure blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do @@ -173,7 +162,7 @@ blockToOrg (Para inlines) = do blockToOrg (LineBlock lns) = do let splitStanza [] = [] splitStanza xs = case break (== mempty) xs of - (l, []) -> l : [] + (l, []) -> [l] (l, _:r) -> l : splitStanza r let joinWithLinefeeds = nowrap . mconcat . intersperse cr let joinWithBlankLines = mconcat . intersperse blankline @@ -213,7 +202,7 @@ blockToOrg (Table caption' _ _ headers rows) = do caption'' <- inlineListToOrg caption' let caption = if null caption' then empty - else ("#+CAPTION: " <> caption'') + else "#+CAPTION: " <> caption'' headers' <- mapM blockListToOrg headers rawRows <- mapM (mapM blockListToOrg) rows let numChars = maximum . map offset @@ -289,8 +278,8 @@ propertiesDrawer (ident, classes, kv) = let drawerStart = text ":PROPERTIES:" drawerEnd = text ":END:" - kv' = if (classes == mempty) then kv else ("CLASS", unwords classes):kv - kv'' = if (ident == mempty) then kv' else ("CUSTOM_ID", ident):kv' + kv' = if classes == mempty then kv else ("CLASS", unwords classes):kv + kv'' = if ident == mempty then kv' else ("CUSTOM_ID", ident):kv' properties = vcat $ map kvToOrgProperty kv'' in drawerStart <> cr <> properties <> cr <> drawerEnd @@ -303,7 +292,7 @@ attrHtml :: Attr -> Doc attrHtml ("" , [] , []) = mempty attrHtml (ident, classes, kvs) = let - name = if (null ident) then mempty else "#+NAME: " <> text ident <> cr + name = if null ident then mempty else "#+NAME: " <> text ident <> cr keyword = "#+ATTR_HTML" classKv = ("class", unwords classes) kvStrings = map (\(k,v) -> ":" <> k <> " " <> v) (classKv:kvs) @@ -370,19 +359,19 @@ inlineToOrg SoftBreak = do WrapPreserve -> return cr WrapAuto -> return space WrapNone -> return space -inlineToOrg (Link _ txt (src, _)) = do +inlineToOrg (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> -- autolink - do return $ "[[" <> text (orgPath x) <> "]]" + return $ "[[" <> text (orgPath x) <> "]]" _ -> do contents <- inlineListToOrg txt return $ "[[" <> text (orgPath src) <> "][" <> contents <> "]]" -inlineToOrg (Image _ _ (source, _)) = do +inlineToOrg (Image _ _ (source, _)) = return $ "[[" <> text (orgPath source) <> "]]" inlineToOrg (Note contents) = do -- add to notes in state notes <- gets stNotes modify $ \st -> st { stNotes = contents:notes } - let ref = show $ (length notes) + 1 + let ref = show $ length notes + 1 return $ "[fn:" <> text ref <> "]" orgPath :: String -> String |