aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/Man.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers/Man.hs')
-rw-r--r--src/Text/Pandoc/Writers/Man.hs103
1 files changed, 52 insertions, 51 deletions
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index f8c895e3c..d9eeb3bfa 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
{- |
Module : Text.Pandoc.Writers.Man
Copyright : Copyright (C) 2007-2019 John MacFarlane
@@ -12,10 +13,10 @@
Conversion of 'Pandoc' documents to roff man page format.
-}
-module Text.Pandoc.Writers.Man ( writeMan) where
+module Text.Pandoc.Writers.Man ( writeMan ) where
import Prelude
import Control.Monad.State.Strict
-import Data.List (intersperse, stripPrefix)
+import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
@@ -73,13 +74,13 @@ pandocToMan opts (Pandoc meta blocks) = do
$ setFieldsFromTitle
$ defField "has-tables" hasTables
$ defField "hyphenate" True
- $ defField "pandoc-version" (T.pack pandocVersion) metadata
+ $ defField "pandoc-version" pandocVersion metadata
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-escString :: WriterOptions -> String -> String
+escString :: WriterOptions -> Text -> Text
escString _ = escapeString AsciiOnly -- for better portability
-- | Return man representation of notes.
@@ -117,30 +118,30 @@ blockToMan opts (Para inlines) = do
blockToMan opts (LineBlock lns) =
blockToMan opts $ linesToPara lns
blockToMan _ b@(RawBlock f str)
- | f == Format "man" = return $ text str
+ | f == Format "man" = return $ literal str
| otherwise = do
report $ BlockNotRendered b
return empty
-blockToMan _ HorizontalRule = return $ text ".PP" $$ text " * * * * *"
+blockToMan _ HorizontalRule = return $ literal ".PP" $$ literal " * * * * *"
blockToMan opts (Header level _ inlines) = do
contents <- inlineListToMan opts inlines
let heading = case level of
1 -> ".SH "
_ -> ".SS "
- return $ nowrap $ text heading <> contents
+ return $ nowrap $ literal heading <> contents
blockToMan opts (CodeBlock _ str) = return $
- text ".IP" $$
- text ".nf" $$
- text "\\f[C]" $$
- ((case str of
- '.':_ -> text "\\&"
- _ -> mempty) <>
- text (escString opts str)) $$
- text "\\f[R]" $$
- text ".fi"
+ literal ".IP" $$
+ literal ".nf" $$
+ literal "\\f[C]" $$
+ ((case T.uncons str of
+ Just ('.',_) -> literal "\\&"
+ _ -> mempty) <>
+ literal (escString opts str)) $$
+ literal "\\f[R]" $$
+ literal ".fi"
blockToMan opts (BlockQuote blocks) = do
contents <- blockListToMan opts blocks
- return $ text ".RS" $$ contents $$ text ".RE"
+ return $ literal ".RS" $$ contents $$ literal ".RE"
blockToMan opts (Table caption alignments widths headers rows) =
let aligncode AlignLeft = "l"
aligncode AlignRight = "r"
@@ -151,24 +152,24 @@ blockToMan opts (Table caption alignments widths headers rows) =
modify $ \st -> st{ stHasTables = True }
let iwidths = if all (== 0) widths
then repeat ""
- else map (printf "w(%0.1fn)" . (70 *)) widths
+ else map (T.pack . printf "w(%0.1fn)" . (70 *)) widths
-- 78n default width - 8n indent = 70n
- let coldescriptions = text $ unwords
- (zipWith (\align width -> aligncode align ++ width)
- alignments iwidths) ++ "."
+ let coldescriptions = literal $ T.unwords
+ (zipWith (\align width -> aligncode align <> width)
+ alignments iwidths) <> "."
colheadings <- mapM (blockListToMan opts) headers
- let makeRow cols = text "T{" $$
- vcat (intersperse (text "T}@T{") cols) $$
- text "T}"
+ let makeRow cols = literal "T{" $$
+ vcat (intersperse (literal "T}@T{") cols) $$
+ literal "T}"
let colheadings' = if all null headers
then empty
else makeRow colheadings $$ char '_'
body <- mapM (\row -> do
cols <- mapM (blockListToMan opts) row
return $ makeRow cols) rows
- return $ text ".PP" $$ caption' $$
- text ".TS" $$ text "tab(@);" $$ coldescriptions $$
- colheadings' $$ vcat body $$ text ".TE"
+ return $ literal ".PP" $$ caption' $$
+ literal ".TS" $$ literal "tab(@);" $$ coldescriptions $$
+ colheadings' $$ vcat body $$ literal ".TE"
blockToMan opts (BulletList items) = do
contents <- mapM (bulletListItemToMan opts) items
@@ -176,7 +177,7 @@ blockToMan opts (BulletList items) = do
blockToMan opts (OrderedList attribs items) = do
let markers = take (length items) $ orderedListMarkers attribs
let indent = 1 +
- maximum (map length markers)
+ maximum (map T.length markers)
contents <- mapM (\(num, item) -> orderedListItemToMan opts num indent item) $
zip markers items
return (vcat contents)
@@ -192,20 +193,20 @@ bulletListItemToMan opts (Para first:rest) =
bulletListItemToMan opts (Plain first:rest) = do
first' <- blockToMan opts (Plain first)
rest' <- blockListToMan opts rest
- let first'' = text ".IP \\[bu] 2" $$ first'
+ let first'' = literal ".IP \\[bu] 2" $$ first'
let rest'' = if null rest
then empty
- else text ".RS 2" $$ rest' $$ text ".RE"
+ else literal ".RS 2" $$ rest' $$ literal ".RE"
return (first'' $$ rest'')
bulletListItemToMan opts (first:rest) = do
first' <- blockToMan opts first
rest' <- blockListToMan opts rest
- return $ text "\\[bu] .RS 2" $$ first' $$ rest' $$ text ".RE"
+ return $ literal "\\[bu] .RS 2" $$ first' $$ rest' $$ literal ".RE"
-- | Convert ordered list item (a list of blocks) to man.
orderedListItemToMan :: PandocMonad m
=> WriterOptions -- ^ options
- -> String -- ^ order marker for list item
+ -> Text -- ^ order marker for list item
-> Int -- ^ number of spaces to indent
-> [Block] -- ^ list item (list of blocks)
-> StateT WriterState m (Doc Text)
@@ -216,10 +217,10 @@ orderedListItemToMan opts num indent (first:rest) = do
first' <- blockToMan opts first
rest' <- blockListToMan opts rest
let num' = printf ("%" ++ show (indent - 1) ++ "s") num
- let first'' = text (".IP \"" ++ num' ++ "\" " ++ show indent) $$ first'
+ let first'' = literal (".IP \"" <> T.pack num' <> "\" " <> tshow indent) $$ first'
let rest'' = if null rest
then empty
- else text ".RS 4" $$ rest' $$ text ".RE"
+ else literal ".RS 4" $$ rest' $$ literal ".RE"
return $ first'' $$ rest''
-- | Convert definition list item (label, list of blocks) to man.
@@ -245,9 +246,9 @@ definitionListItemToMan opts (label, defs) = do
return $ first' $$
if null xs
then empty
- else text ".RS" $$ rest' $$ text ".RE"
+ else literal ".RS" $$ rest' $$ literal ".RE"
[] -> return empty
- return $ text ".TP" $$ nowrap labelText $$ contents
+ return $ literal ".TP" $$ nowrap labelText $$ contents
makeCodeBold :: [Inline] -> [Inline]
makeCodeBold = walk go
@@ -275,7 +276,7 @@ inlineToMan opts (Strong lst) =
withFontFeature 'B' (inlineListToMan opts lst)
inlineToMan opts (Strikeout lst) = do
contents <- inlineListToMan opts lst
- return $ text "[STRIKEOUT:" <> contents <> char ']'
+ return $ literal "[STRIKEOUT:" <> contents <> char ']'
inlineToMan opts (Superscript lst) = do
contents <- inlineListToMan opts lst
return $ char '^' <> contents <> char '^'
@@ -288,48 +289,48 @@ inlineToMan opts (Quoted SingleQuote lst) = do
return $ char '`' <> contents <> char '\''
inlineToMan opts (Quoted DoubleQuote lst) = do
contents <- inlineListToMan opts lst
- return $ text "\\[lq]" <> contents <> text "\\[rq]"
+ return $ literal "\\[lq]" <> contents <> literal "\\[rq]"
inlineToMan opts (Cite _ lst) =
inlineListToMan opts lst
inlineToMan opts (Code _ str) =
- withFontFeature 'C' (return (text $ escString opts str))
-inlineToMan opts (Str str@('.':_)) =
- return $ afterBreak "\\&" <> text (escString opts str)
-inlineToMan opts (Str str) = return $ text $ escString opts str
+ withFontFeature 'C' (return (literal $ escString opts str))
+inlineToMan opts (Str str@(T.uncons -> Just ('.',_))) =
+ return $ afterBreak "\\&" <> literal (escString opts str)
+inlineToMan opts (Str str) = return $ literal $ escString opts str
inlineToMan opts (Math InlineMath str) =
lift (texMathToInlines InlineMath str) >>= inlineListToMan opts
inlineToMan opts (Math DisplayMath str) = do
contents <- lift (texMathToInlines DisplayMath str) >>= inlineListToMan opts
- return $ cr <> text ".RS" $$ contents $$ text ".RE"
+ return $ cr <> literal ".RS" $$ contents $$ literal ".RE"
inlineToMan _ il@(RawInline f str)
- | f == Format "man" = return $ text str
+ | f == Format "man" = return $ literal str
| otherwise = do
report $ InlineNotRendered il
return empty
inlineToMan _ LineBreak = return $
- cr <> text ".PD 0" $$ text ".P" $$ text ".PD" <> cr
+ cr <> literal ".PD 0" $$ literal ".P" $$ literal ".PD" <> cr
inlineToMan _ SoftBreak = return space
inlineToMan _ Space = return space
inlineToMan opts (Link _ txt (src, _))
| not (isURI src) = inlineListToMan opts txt -- skip relative links
| otherwise = do
linktext <- inlineListToMan opts txt
- let srcSuffix = fromMaybe src (stripPrefix "mailto:" src)
+ let srcSuffix = fromMaybe src (T.stripPrefix "mailto:" src)
return $ case txt of
[Str s]
| escapeURI s == srcSuffix ->
- char '<' <> text srcSuffix <> char '>'
- _ -> linktext <> text " (" <> text src <> char ')'
+ char '<' <> literal srcSuffix <> char '>'
+ _ -> linktext <> literal " (" <> literal src <> char ')'
inlineToMan opts (Image attr alternate (source, tit)) = do
let txt = if null alternate || (alternate == [Str ""]) ||
(alternate == [Str source]) -- to prevent autolinks
then [Str "image"]
else alternate
linkPart <- inlineToMan opts (Link attr txt (source, tit))
- return $ char '[' <> text "IMAGE: " <> linkPart <> char ']'
+ return $ char '[' <> literal "IMAGE: " <> linkPart <> char ']'
inlineToMan _ (Note contents) = do
-- add to notes in state
modify $ \st -> st{ stNotes = contents : stNotes st }
notes <- gets stNotes
- let ref = show (length notes)
- return $ char '[' <> text ref <> char ']'
+ let ref = tshow (length notes)
+ return $ char '[' <> literal ref <> char ']'
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 09:14:29 +0000