add ANSI writer

cabal.project

@@ -16,3 +16,8 @@ source-repository-package
  type: git
  location: https://github.com/jgm/texmath
  tag: 66e747472d87b2379f4224dd8efb5950e3aef966
+
+source-repository-package
+ type: git
+ location: https://github.com/jgm/doclayout
+ tag: fc29e457456b66d7e8d7fcd98170ddef51bef4f4

data/templates/default.ansi

@@ -0,0 +1,21 @@
+$if(titleblock)$
+$titleblock$
+
+$endif$
+$for(header-includes)$
+$header-includes$
+
+$endfor$
+$for(include-before)$
+$include-before$
+
+$endfor$
+$if(toc)$
+$table-of-contents$
+
+$endif$
+$body$
+$for(include-after)$
+
+$include-after$
+$endfor$

pandoc.cabal

@@ -632,6 +632,7 @@ library
  Text.Pandoc.Writers.OOXML,
  Text.Pandoc.Writers.AnnotatedTable,
  Text.Pandoc.Writers.BibTeX,
+ Text.Pandoc.Writers.ANSI,
  Text.Pandoc.PDF,
  Text.Pandoc.UTF8,
  Text.Pandoc.Scripting,

src/Text/Pandoc/Highlighting.hs

@@ -29,6 +29,7 @@ module Text.Pandoc.Highlighting ( highlightingStyles
  , formatConTeXtInline
  , formatConTeXtBlock
  , styleToConTeXt
+ , formatANSI
  -- * Styles
  , pygments
  , espresso

src/Text/Pandoc/Writers.hs

@@ -19,6 +19,7 @@ module Text.Pandoc.Writers
  -- * Writers: converting /from/ Pandoc format
  Writer(..)
  , writers
+ , writeANSI
  , writeAsciiDoc
  , writeAsciiDocLegacy
  , writeAsciiDoctor
@@ -90,6 +91,7 @@ import qualified Text.Pandoc.Format as Format
 import Text.Pandoc.Options
 import qualified Text.Pandoc.UTF8 as UTF8
 import Text.Pandoc.Error
+import Text.Pandoc.Writers.ANSI
 import Text.Pandoc.Writers.AsciiDoc
 import Text.Pandoc.Writers.BibTeX
 import Text.Pandoc.Writers.ChunkedHTML
@@ -200,6 +202,7 @@ writers = [
  ,("markua" , TextWriter writeMarkua)
  ,("chunkedhtml" , ByteStringWriter writeChunkedHTML)
  ,("djot" , TextWriter writeDjot)
+ ,("ansi" , TextWriter writeANSI)
  ]
 
 -- | Retrieve writer, extensions based on formatSpec (format+extensions).

src/Text/Pandoc/Writers/ANSI.hs

@@ -0,0 +1,306 @@
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+ Module : Text.Pandoc.Writers.ANSI
+ Copyright : Copyright (C) 2024 Evan Silberman
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <[email protected]>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' documents to Ansi terminal output.
+-}
+module Text.Pandoc.Writers.ANSI ( writeANSI ) where
+import Control.Monad.State.Strict ( StateT, gets, modify, evalStateT )
+import Data.List (intersperse)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Text.DocLayout ((<+>), ($$), ($+$))
+import Text.DocTemplates (Context(..))
+import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
+import Text.Pandoc.Definition
+import Text.Pandoc.Highlighting (highlight, formatANSI)
+import Text.Pandoc.Logging
+import Text.Pandoc.Options
+import Text.Pandoc.Shared
+import Text.Pandoc.Templates (renderTemplate)
+import qualified Text.Pandoc.Translations as L
+import Text.Pandoc.Writers.Math(texMathToInlines)
+import Text.Pandoc.Writers.Shared
+import qualified Data.Text as T
+import Data.Text.Lazy (toStrict)
+import qualified Text.DocLayout as D
+
+hr :: D.HasChars a => D.Doc a
+hr = D.literal $ D.replicateChar 20 '─'
+
+data WriterState = WriterState {
+ stNotes :: [D.Doc Text] -- Footnotes
+ , stColumns :: Int -- Width of the rendered text block
+ , stInner :: Bool -- Are we at the document's top-level or in a nested construct?
+ , stNextFigureNum :: Int
+ , stInFigure :: Bool
+ }
+
+type TW = StateT WriterState
+
+withFewerColumns :: PandocMonad m => Int -> TW m a -> TW m a
+withFewerColumns n a = do
+ cols <- gets stColumns
+ inner <- gets stInner
+ modify $ \s -> s{stColumns = max (cols - n) 4, stInner = True}
+ result <- a
+ modify $ \s -> s{stColumns = cols, stInner = inner}
+ return result
+
+-- | Convert Pandoc to ANSI
+writeANSI :: PandocMonad m => WriterOptions -> Pandoc -> m Text
+writeANSI opts document =
+ evalStateT (pandocToANSI opts document)
+ WriterState { stNotes = [],
+ stColumns = (writerColumns opts),
+ stInner = False,
+ stNextFigureNum = 1,
+ stInFigure = False
+ }
+
+-- | Return ANSI-styled verison of document
+pandocToANSI :: PandocMonad m
+ => WriterOptions -> Pandoc -> TW m Text
+pandocToANSI opts (Pandoc meta blocks) = do
+ metadata <- metaToContext opts
+ (blockListToANSI opts)
+ (inlineListToANSI opts) meta
+ width <- gets stColumns
+ let title = titleBlock width metadata
+ let blocks' = makeSections (writerNumberSections opts) Nothing blocks
+ body <- blockListToANSI opts blocks'
+ notes <- gets $ reverse . stNotes
+ let notemark x = D.literal (tshow (x :: Int) <> ".") <+> D.space
+ let marks = take (length notes) $ map notemark [1..]
+ let hangWidth = foldr (max . D.offset) 0 marks
+ let notepretty | not (null notes) = D.cblock width hr $+$ hangMarks hangWidth marks notes
+ | otherwise = D.empty
+ let main = body $+$ notepretty
+ let context = defField "body" main
+ $ defField "titleblock" title metadata
+ return $
+ case writerTemplate opts of
+ Nothing -> toStrict $ D.renderANSI (Just width) main
+ Just tpl -> toStrict $ D.renderANSI (Just width) $ renderTemplate tpl context
+
+titleBlock :: Int -> Context Text -> D.Doc Text
+titleBlock width meta = if null most then D.empty else D.cblock width $ most $+$ hr
+ where
+ title = D.bold (fromMaybe D.empty $ getField "title" meta)
+ subtitle = fromMaybe D.empty $ getField "subtitle" meta
+ author = D.vcat $ fromMaybe [] $ getField "author" meta
+ date = D.italic (fromMaybe D.empty $ getField "date" meta)
+ most = (title $$ subtitle) $+$ author $+$ date
+
+hangMarks :: Int -> [D.Doc Text] -> [D.Doc Text] -> D.Doc Text
+hangMarks width markers contents =
+ D.vsep (zipWith hangMark markers contents) where
+ hangMark m d = D.rblock width m <+> D.nest (width + 1) d
+
+stackMarks :: [D.Doc Text] -> [D.Doc Text] -> D.Doc Text
+stackMarks markers contents = D.vsep (zipWith stack markers contents)
+ where stack m d = m $$ D.nest 4 d
+
+-- | Convert Pandoc block element to ANSI
+blockToANSI :: PandocMonad m
+ => WriterOptions -- ^ Options
+ -> Block -- ^ Block element
+ -> TW m (D.Doc Text)
+
+blockToANSI opts (Div _ bs) = blockListToANSI opts bs
+
+blockToANSI opts (Plain inlines) = inlineListToANSI opts inlines
+
+blockToANSI opts (Para inlines) = inlineListToANSI opts inlines
+
+blockToANSI opts (LineBlock lns) = blockToANSI opts $ linesToPara lns
+
+blockToANSI _ b@(RawBlock _ _) = do
+ report $ BlockNotRendered b
+ return D.empty
+
+blockToANSI _ HorizontalRule = return $ D.blankline $$ hr $$ D.blankline
+
+blockToANSI opts (Header level (_, classes, kvs) inlines) = do
+ contents <- inlineListToANSI opts inlines
+ inner <- gets stInner
+ let secnum = fromMaybe mempty $ lookup "number" kvs
+ let doNumber = writerNumberSections opts && not (T.null secnum) && "unnumbered" `notElem` classes
+ let number | doNumber = D.hang (D.realLength secnum + 1) (header level (D.literal secnum) <> D.space)
+ | otherwise = id
+ return $ number (color inner (header level contents)) $$ D.blankline where
+ header 1 = (fmap T.toUpper) . D.bold
+ header 2 = D.bold
+ header _ = D.italic
+ color False = D.fg D.green
+ color True = id
+
+-- The approach to code blocks and highlighting here is a best-effort with
+-- existing tools, and can easily produce results that aren't quite right. Using
+-- line numbers together with certain highlight styles interacts poorly with
+-- the "nest" combinator being applied to the whole document. The Skylighting
+-- formatANSI function produces fully-rendered results; a more ambitious
+-- approach here could process SourceLines into a Doc Text.
+blockToANSI opts (CodeBlock attr str) =
+ case writerHighlightStyle opts of
+ Nothing -> return $ D.literal str
+ Just s -> do
+ let fmt o = formatANSI o s
+ result = highlight (writerSyntaxMap opts) fmt attr str
+ return $ case result of
+ Left _ -> D.literal str
+ Right f -> D.literal f
+
+blockToANSI opts (BlockQuote blocks) = do
+ contents <- withFewerColumns 2 $ blockListToANSI opts blocks
+ return ( D.prefixed "│ " contents $$ D.blankline)
+
+blockToANSI _ Table{} = do
+ return $ D.literal "[TABLE]"
+
+blockToANSI opts (BulletList items) = do
+ contents <- withFewerColumns 2 $ mapM (blockListToANSI opts) items
+ return $ D.vsep (fmap hangMark contents) where
+ hangMark d = D.hang 2 (D.literal "• ") d
+
+blockToANSI opts (OrderedList attribs items) = do
+ let markers = fmap D.literal $ take (length items) $ orderedListMarkers attribs
+ let hangWidth = foldr (max . D.offset) 0 markers
+ contents <- withFewerColumns hangWidth $ mapM (blockListToANSI opts) items
+ return $ hangMarks hangWidth markers contents <> D.cr
+
+blockToANSI opts (DefinitionList items) = do
+ labels <- mapM (inlineListToANSI opts . fst) items
+ columns <- gets stColumns
+ let hangWidth = foldr (max . D.offset) 0 labels
+ if hangWidth > floor (toRational columns / 10 * 3)
+ then do
+ contents <- withFewerColumns 4 $ mapM ((mapM (blockListToANSI opts)) . snd) items
+ return $ stackMarks (D.bold <$> labels) (D.vsep <$> contents) <> D.cr
+ else do
+ contents <- withFewerColumns hangWidth $ mapM ((mapM (blockListToANSI opts)) . snd) items
+ return $ hangMarks hangWidth (D.bold <$> labels) (D.vsep <$> contents) <> D.cr
+
+blockToANSI opts (Figure _ (Caption _ caption) body) = do
+ let captionInlines = blocksToInlines caption
+ figTerm <- L.translateTerm L.Figure
+ num <- gets stNextFigureNum
+ figState <- gets stInFigure
+ modify $ \s -> s{stNextFigureNum = num + 1}
+ let label = D.literal figTerm <+> D.literal (tshow num)
+ captionMarkup <- if null captionInlines
+ then return (D.italic label)
+ else do
+ cap <- inlineListToANSI opts (blocksToInlines caption)
+ return $ (D.italic (label <> D.literal ":")) <+> cap
+ modify $ \s -> s{stInFigure = True}
+ contents <- blockListToANSI opts body
+ modify $ \s -> s{stInFigure = figState}
+ return $ contents $$ captionMarkup
+
+-- Auxiliary functions for lists:
+
+-- | Convert list of Pandoc block elements to ANSI
+blockListToANSI :: PandocMonad m
+ => WriterOptions -- ^ Options
+ -> [Block] -- ^ List of block elements
+ -> TW m (D.Doc Text)
+blockListToANSI opts blocks =
+ D.vsep <$> mapM (blockToANSI opts) blocks
+
+-- | Convert list of Pandoc inline elements to ANSI
+inlineListToANSI :: PandocMonad m
+ => WriterOptions -> [Inline] -> TW m (D.Doc Text)
+inlineListToANSI opts lst =
+ D.hcat <$> mapM (inlineToANSI opts) lst
+
+-- | Convert Pandoc inline element to ANSI
+inlineToANSI :: PandocMonad m => WriterOptions -> Inline -> TW m (D.Doc Text)
+
+inlineToANSI opts (Span _ lst) =
+ inlineListToANSI opts lst
+
+inlineToANSI opts (Emph lst) = do
+ contents <- inlineListToANSI opts lst
+ return $ D.italic contents
+
+inlineToANSI opts (Underline lst) = do
+ contents <- inlineListToANSI opts lst
+ return $ D.underlined contents
+
+inlineToANSI opts (Strong lst) = do
+ contents <- inlineListToANSI opts lst
+ return $ D.bold contents
+
+inlineToANSI opts (Strikeout lst) = do
+ contents <- inlineListToANSI opts lst
+ return $ D.strikeout contents
+
+inlineToANSI opts (Superscript lst) = do
+ case traverse toSuperscriptInline lst of
+ Just xs -> inlineListToANSI opts xs
+ Nothing -> inlineListToANSI opts lst >>= return . D.parens
+
+inlineToANSI opts (Subscript lst) = do
+ case traverse toSuperscriptInline lst of
+ Just xs -> inlineListToANSI opts xs
+ Nothing -> inlineListToANSI opts lst >>= return . D.parens
+
+inlineToANSI opts (SmallCaps lst) = inlineListToANSI opts lst
+
+inlineToANSI opts (Quoted SingleQuote lst) = do
+ contents <- inlineListToANSI opts lst
+ return $ "‘" <> contents <> "’"
+
+inlineToANSI opts (Quoted DoubleQuote lst) = do
+ contents <- inlineListToANSI opts lst
+ return $ "“" <> contents <> "”"
+
+inlineToANSI opts (Cite _ lst) = inlineListToANSI opts lst
+
+-- Making a judgment call here that for ANSI-formatted output
+-- intended for reading, we want to reflow inline Code on spaces
+inlineToANSI _ (Code _ str) =
+ return $ D.bg D.white $ D.fg D.red $ " " <> D.hcat flow <> " "
+ where flow = intersperse D.space (D.literal <$> T.words str)
+
+inlineToANSI _ (Str str) = return $ D.literal str
+
+inlineToANSI opts (Math t str) = texMathToInlines t str >>= inlineListToANSI opts
+
+inlineToANSI _ il@RawInline{} = do
+ report $ InlineNotRendered il
+ return ""
+
+inlineToANSI _ LineBreak = return D.cr
+
+inlineToANSI _ SoftBreak = return D.space
+
+inlineToANSI _ Space = return D.space
+
+inlineToANSI opts (Link (_, _, _) txt (src, _)) = do
+ label <- inlineListToANSI opts txt
+ return $ D.underlined $ D.fg D.cyan $ D.link src label
+
+inlineToANSI opts (Image _ alt _) = do
+ infig <- gets stInFigure
+ if not infig then do
+ alt' <- inlineListToANSI opts alt
+ return $ D.brackets $ "image: " <> alt'
+ else return $ D.brackets "image"
+
+-- by construction, we should never be lacking in superscript characters
+-- for the footnote number, but we'll fall back to square brackets anyway
+inlineToANSI opts (Note contents) = do
+ curNotes <- gets stNotes
+ let newnum = tshow $ length curNotes + 1
+ contents' <- blockListToANSI opts contents
+ modify $ \s -> s { stNotes = contents' : curNotes }
+ let super = T.pack <$> (traverse toSuperscript (T.unpack newnum))
+ return $ D.literal $ fromMaybe ("[" <> newnum <> "]") super

src/Text/Pandoc/Writers/ICML.hs

@@ -30,7 +30,7 @@ import Text.Pandoc.Definition
 import Text.Pandoc.ImageSize
 import Text.Pandoc.Logging
 import Text.Pandoc.Options
-import Text.DocLayout
+import Text.DocLayout hiding (link)
 import Text.Pandoc.Shared
 import Text.Pandoc.URI (isURI)
 import Text.Pandoc.Templates (renderTemplate)