Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

More hlint.

Browse source
This commit is contained in:
John MacFarlane 2017-10-29 13:19:15 -07:00
parent 218d212f30
commit 271e1fe2f1
3 changed files with 30 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
src/Text/Pandoc/Writers/AsciiDoc.hs
View file

@ -42,7 +42,7 @@ import Data.Aeson (Result (..), Value (String), fromJSON, toJSON)
import Data.Char (isPunctuation, isSpace) import Data.Char (isPunctuation, isSpace)
import Data.List (intercalate, intersperse, stripPrefix) import Data.List (intercalate, intersperse, stripPrefix)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe, isJust)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Class (PandocMonad, report)
@ -100,9 +100,8 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do
let context = defField "body" main let context = defField "body" main
$ defField "toc" $ defField "toc"
(writerTableOfContents opts && (writerTableOfContents opts &&
writerTemplate opts /= Nothing) Data.Maybe.isJust (writerTemplate opts))
$ defField "titleblock" titleblock $defField "titleblock" titleblock metadata'
$ metadata'
case writerTemplate opts of case writerTemplate opts of
Nothing -> return main Nothing -> return main
Just tpl -> renderTemplate' tpl context Just tpl -> renderTemplate' tpl context
@ -137,7 +136,7 @@ blockToAsciiDoc _ Null = return empty
blockToAsciiDoc opts (Plain inlines) = do blockToAsciiDoc opts (Plain inlines) = do
contents <- inlineListToAsciiDoc opts inlines contents <- inlineListToAsciiDoc opts inlines
return $ contents <> blankline return $ contents <> blankline
blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) =
blockToAsciiDoc opts (Para [Image attr alt (src,tit)]) blockToAsciiDoc opts (Para [Image attr alt (src,tit)])
blockToAsciiDoc opts (Para inlines) = do blockToAsciiDoc opts (Para inlines) = do
contents <- inlineListToAsciiDoc opts inlines contents <- inlineListToAsciiDoc opts inlines
@ -165,9 +164,9 @@ 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 $$
@ -179,7 +178,7 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do
_ -> 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 $ (flush $ blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ flush (
if null classes if null classes
then "...." $$ text str $$ "...." then "...." $$ text str $$ "...."
else attrs $$ "----" $$ text str $$ "----") else attrs $$ "----" $$ text str $$ "----")
@ -204,7 +203,7 @@ blockToAsciiDoc opts (Table caption aligns widths headers rows) = do
let isSimple = all (== 0) widths let isSimple = all (== 0) widths
let relativePercentWidths = if isSimple let relativePercentWidths = if isSimple
then widths then widths
else map (/ (sum widths)) widths else map (/ sum widths) widths
let widths'' :: [Integer] let widths'' :: [Integer]
widths'' = map (floor . (* 100)) relativePercentWidths widths'' = map (floor . (* 100)) relativePercentWidths
-- ensure that the widths sum to 100 -- ensure that the widths sum to 100
@ -266,14 +265,14 @@ blockToAsciiDoc opts (OrderedList (_start, sty, _delim) items) = do
let markers' = map (\m -> if length m < 3 let markers' = map (\m -> if length m < 3
then m ++ replicate (3 - length m) ' ' then m ++ replicate (3 - length m) ' '
else m) markers else m) markers
contents <- mapM (\(item, num) -> orderedListItemToAsciiDoc opts item num) $ contents <- mapM (uncurry (orderedListItemToAsciiDoc opts)) $
zip markers' items zip markers' items
return $ cat contents <> blankline return $ cat contents <> blankline
blockToAsciiDoc opts (DefinitionList items) = do blockToAsciiDoc opts (DefinitionList items) = do
contents <- mapM (definitionListItemToAsciiDoc opts) items contents <- mapM (definitionListItemToAsciiDoc opts) items
return $ cat contents <> blankline return $ cat contents <> blankline
blockToAsciiDoc opts (Div (ident,_,_) bs) = do blockToAsciiDoc opts (Div (ident,_,_) bs) = do
let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") let identifier = if null ident then empty else ("[[" <> text ident <> "]]")
contents <- blockListToAsciiDoc opts bs contents <- blockListToAsciiDoc opts bs
return $ identifier $$ contents return $ identifier $$ contents
@ -460,7 +459,7 @@ inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do
let linktitle = if null tit let linktitle = if null tit
then empty then empty
else ",title=\"" <> text tit <> "\"" else ",title=\"" <> text tit <> "\""
showDim dir = case (dimension dir attr) of showDim dir = case dimension dir attr of
Just (Percent a) -> Just (Percent a) ->
["scaledwidth=" <> text (show (Percent a))] ["scaledwidth=" <> text (show (Percent a))]
Just dim -> Just dim ->
@ -480,6 +479,6 @@ inlineToAsciiDoc opts (Note [Plain inlines]) = do
-- asciidoc can't handle blank lines in notes -- asciidoc can't handle blank lines in notes
inlineToAsciiDoc _ (Note _) = return "[multiblock footnote omitted]" inlineToAsciiDoc _ (Note _) = return "[multiblock footnote omitted]"
inlineToAsciiDoc opts (Span (ident,_,_) ils) = do inlineToAsciiDoc opts (Span (ident,_,_) ils) = do
let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") let identifier = if null ident then empty else ("[[" <> text ident <> "]]")
contents <- inlineListToAsciiDoc opts ils contents <- inlineListToAsciiDoc opts ils
return $ identifier <> contents return $ identifier <> contents

12
src/Text/Pandoc/Writers/CommonMark.hs
View file

@ -60,7 +60,7 @@ writeCommonMark opts (Pandoc meta blocks) = do
(blocksToCommonMark opts) (blocksToCommonMark opts)
(inlinesToCommonMark opts) (inlinesToCommonMark opts)
meta meta
let context = defField "body" main $ metadata let context = defField "body" main metadata
case writerTemplate opts of case writerTemplate opts of
Nothing -> return main Nothing -> return main
Just tpl -> renderTemplate' tpl context Just tpl -> renderTemplate' tpl context
@ -108,11 +108,11 @@ blockToNodes opts (Plain xs) ns =
blockToNodes opts (Para xs) ns = blockToNodes opts (Para xs) ns =
return (node PARAGRAPH (inlinesToNodes opts xs) : ns) return (node PARAGRAPH (inlinesToNodes opts xs) : ns)
blockToNodes opts (LineBlock lns) ns = blockToNodes opts (linesToPara lns) ns blockToNodes opts (LineBlock lns) ns = blockToNodes opts (linesToPara lns) ns
blockToNodes _ (CodeBlock (_,classes,_) xs) ns = return $ blockToNodes _ (CodeBlock (_,classes,_) xs) ns = return
(node (CODE_BLOCK (T.pack (unwords classes)) (T.pack xs)) [] : ns) (node (CODE_BLOCK (T.pack (unwords classes)) (T.pack xs)) [] : ns)
blockToNodes _ (RawBlock fmt xs) ns blockToNodes _ (RawBlock fmt xs) ns
| fmt == Format "html" = return (node (HTML_BLOCK (T.pack xs)) [] : ns) | fmt == Format "html" = return (node (HTML_BLOCK (T.pack xs)) [] : ns)
| otherwise = return (node (CUSTOM_BLOCK (T.pack xs) (T.empty)) [] : ns) | otherwise = return (node (CUSTOM_BLOCK (T.pack xs) T.empty) [] : ns)
blockToNodes opts (BlockQuote bs) ns = do blockToNodes opts (BlockQuote bs) ns = do
nodes <- blocksToNodes opts bs nodes <- blocksToNodes opts bs
return (node BLOCK_QUOTE nodes : ns) return (node BLOCK_QUOTE nodes : ns)
@ -142,9 +142,9 @@ blockToNodes opts (Div _ bs) ns = do
blockToNodes opts (DefinitionList items) ns = blockToNodes opts (DefinitionList items) ns =
blockToNodes opts (BulletList items') ns blockToNodes opts (BulletList items') ns
where items' = map dlToBullet items where items' = map dlToBullet items
dlToBullet (term, ((Para xs : ys) : zs)) = dlToBullet (term, (Para xs : ys) : zs) =
Para (term ++ [LineBreak] ++ xs) : ys ++ concat zs Para (term ++ [LineBreak] ++ xs) : ys ++ concat zs
dlToBullet (term, ((Plain xs : ys) : zs)) = dlToBullet (term, (Plain xs : ys) : zs) =
Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs
dlToBullet (term, xs) = dlToBullet (term, xs) =
Para term : concat xs Para term : concat xs
@ -264,7 +264,7 @@ inlineToNodes opts (Image _ ils (url,tit)) =
(node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :) (node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :)
inlineToNodes _ (RawInline fmt xs) inlineToNodes _ (RawInline fmt xs)
| fmt == Format "html" = (node (HTML_INLINE (T.pack xs)) [] :) | fmt == Format "html" = (node (HTML_INLINE (T.pack xs)) [] :)
| otherwise = (node (CUSTOM_INLINE (T.pack xs) (T.empty)) [] :) | otherwise = (node (CUSTOM_INLINE (T.pack xs) T.empty) [] :)
inlineToNodes opts (Quoted qt ils) = inlineToNodes opts (Quoted qt ils) =
((node (TEXT start) [] : ((node (TEXT start) [] :
inlinesToNodes opts ils ++ [node (TEXT end) []]) ++) inlinesToNodes opts ils ++ [node (TEXT end) []]) ++)

26
src/Text/Pandoc/Writers/ConTeXt.hs
View file

@ -33,7 +33,7 @@ module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
import Control.Monad.State.Strict import Control.Monad.State.Strict
import Data.Char (ord) import Data.Char (ord)
import Data.List (intercalate, intersperse) import Data.List (intercalate, intersperse)
import Data.Maybe (catMaybes) import Data.Maybe (mapMaybe)
import Data.Text (Text) import Data.Text (Text)
import Network.URI (unEscapeString) import Network.URI (unEscapeString)
import Text.Pandoc.BCP47 import Text.Pandoc.BCP47
@ -82,8 +82,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do
meta meta
body <- mapM (elementToConTeXt options) $ hierarchicalize blocks body <- mapM (elementToConTeXt options) $ hierarchicalize blocks
let main = (render' . vcat) body let main = (render' . vcat) body
let layoutFromMargins = intercalate [','] $ catMaybes $ let layoutFromMargins = intercalate [','] $ mapMaybe (\(x,y) ->
map (\(x,y) ->
((x ++ "=") ++) <$> getField y metadata) ((x ++ "=") ++) <$> getField y metadata)
[("leftmargin","margin-left") [("leftmargin","margin-left")
,("rightmargin","margin-right") ,("rightmargin","margin-right")
@ -107,8 +106,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do
$ (case getField "papersize" metadata of $ (case getField "papersize" metadata of
Just ("a4" :: String) -> resetField "papersize" Just ("a4" :: String) -> resetField "papersize"
("A4" :: String) ("A4" :: String)
_ -> id) _ -> id) metadata
$ metadata
let context' = defField "context-dir" (toContextDir let context' = defField "context-dir" (toContextDir
$ getField "dir" context) context $ getField "dir" context) context
case writerTemplate options of case writerTemplate options of
@ -150,7 +148,7 @@ stringToConTeXt opts = concatMap (escapeCharForConTeXt opts)
toLabel :: String -> String toLabel :: String -> String
toLabel z = concatMap go z toLabel z = concatMap go z
where go x where go x
| elem x ("\\#[]\",{}%()|=" :: String) = "ux" ++ printf "%x" (ord x) | x `elem` ("\\#[]\",{}%()|=" :: String) = "ux" ++ printf "%x" (ord x)
| otherwise = [x] | otherwise = [x]
-- | Convert Elements to ConTeXt -- | Convert Elements to ConTeXt
@ -206,7 +204,7 @@ blockToConTeXt (Div (ident,_,kvs) bs) = do
<> text lng <> "]" $$ txt $$ "\\stop" <> text lng <> "]" $$ txt $$ "\\stop"
Nothing -> txt Nothing -> txt
wrapBlank txt = blankline <> txt <> blankline wrapBlank txt = blankline <> txt <> blankline
fmap (wrapBlank . wrapLang . wrapDir . wrapRef) $ blockListToConTeXt bs (wrapBlank . wrapLang . wrapDir . wrapRef) <$> blockListToConTeXt bs
blockToConTeXt (BulletList lst) = do blockToConTeXt (BulletList lst) = do
contents <- mapM listItemToConTeXt lst contents <- mapM listItemToConTeXt lst
return $ ("\\startitemize" <> if isTightList lst return $ ("\\startitemize" <> if isTightList lst
@ -261,7 +259,7 @@ blockToConTeXt (Table caption aligns widths heads rows) = do
if colWidth == 0 if colWidth == 0
then "|" then "|"
else ("p(" ++ printf "%.2f" colWidth ++ "\\textwidth)|") else ("p(" ++ printf "%.2f" colWidth ++ "\\textwidth)|")
let colDescriptors = "|" ++ (concat $ let colDescriptors = "|" ++ concat (
zipWith colDescriptor widths aligns) zipWith colDescriptor widths aligns)
headers <- if all null heads headers <- if all null heads
then return empty then return empty
@ -279,11 +277,11 @@ blockToConTeXt (Table caption aligns widths heads rows) = do
tableRowToConTeXt :: PandocMonad m => [[Block]] -> WM m Doc tableRowToConTeXt :: PandocMonad m => [[Block]] -> WM m Doc
tableRowToConTeXt cols = do tableRowToConTeXt cols = do
cols' <- mapM blockListToConTeXt cols cols' <- mapM blockListToConTeXt cols
return $ (vcat (map ("\\NC " <>) cols')) $$ "\\NC\\AR" return $ vcat (map ("\\NC " <>) cols') $$ "\\NC\\AR"
listItemToConTeXt :: PandocMonad m => [Block] -> WM m Doc listItemToConTeXt :: PandocMonad m => [Block] -> WM m Doc
listItemToConTeXt list = blockListToConTeXt list >>= listItemToConTeXt list = blockListToConTeXt list >>=
return . ("\\item" $$) . (nest 2) return . ("\\item" $$) . nest 2
defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m Doc defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m Doc
defListItemToConTeXt (term, defs) = do defListItemToConTeXt (term, defs) = do
@ -358,7 +356,7 @@ inlineToConTeXt (RawInline "tex" str) = return $ text str
inlineToConTeXt il@(RawInline _ _) = do inlineToConTeXt il@(RawInline _ _) = do
report $ InlineNotRendered il report $ InlineNotRendered il
return empty return empty
inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr inlineToConTeXt LineBreak = return $ text "\\crlf" <> cr
inlineToConTeXt SoftBreak = do inlineToConTeXt SoftBreak = do
wrapText <- gets (writerWrapText . stOptions) wrapText <- gets (writerWrapText . stOptions)
return $ case wrapText of return $ case wrapText of
@ -367,7 +365,7 @@ inlineToConTeXt SoftBreak = do
WrapPreserve -> cr WrapPreserve -> cr
inlineToConTeXt Space = return space inlineToConTeXt Space = return space
-- Handle HTML-like internal document references to sections -- Handle HTML-like internal document references to sections
inlineToConTeXt (Link _ txt (('#' : ref), _)) = do inlineToConTeXt (Link _ txt ('#' : ref, _)) = do
opts <- gets stOptions opts <- gets stOptions
contents <- inlineListToConTeXt txt contents <- inlineListToConTeXt txt
let ref' = toLabel $ stringToConTeXt opts ref let ref' = toLabel $ stringToConTeXt opts ref
@ -393,7 +391,7 @@ inlineToConTeXt (Link _ txt (src, _)) = do
inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do
opts <- gets stOptions opts <- gets stOptions
let showDim dir = let d = text (show dir) <> "=" let showDim dir = let d = text (show dir) <> "="
in case (dimension dir attr) of in case dimension dir attr of
Just (Pixel a) -> Just (Pixel a) ->
[d <> text (showInInch opts (Pixel a)) <> "in"] [d <> text (showInInch opts (Pixel a)) <> "in"]
Just (Percent a) -> Just (Percent a) ->
@ -432,7 +430,7 @@ inlineToConTeXt (Span (_,_,kvs) ils) = do
Just lng -> "\\start\\language[" <> text lng Just lng -> "\\start\\language[" <> text lng
<> "]" <> txt <> "\\stop " <> "]" <> txt <> "\\stop "
Nothing -> txt Nothing -> txt
fmap (wrapLang . wrapDir) $ inlineListToConTeXt ils (wrapLang . wrapDir) <$> inlineListToConTeXt ils
-- | Craft the section header, inserting the section reference, if supplied. -- | Craft the section header, inserting the section reference, if supplied.
sectionHeader :: PandocMonad m sectionHeader :: PandocMonad m