{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.ANSI
   Copyright   : Copyright (C) 2024 Evan Silberman
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   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 Control.Monad (foldM)
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 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 :: forall a. HasChars a => Doc a
hr = Int -> Doc a
forall a. HasChars a => Int -> Doc a
rule Int
20

rule :: D.HasChars a => Int -> D.Doc a
rule :: forall a. HasChars a => Int -> Doc a
rule Int
n = a -> Doc a
forall a. HasChars a => a -> Doc a
D.literal (a -> Doc a) -> a -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> Char -> a
forall a. HasChars a => Int -> Char -> a
D.replicateChar Int
n Char
'─'

data WriterState = WriterState {
    WriterState -> [Doc Text]
stNotes     :: [D.Doc Text]        -- Footnotes
  , WriterState -> Int
stColumns   :: Int         -- Width of the rendered text block
  , WriterState -> Bool
stInner     :: Bool    -- Are we at the document's top-level or in a nested construct?
  , WriterState -> Int
stNextFigureNum :: Int
  , WriterState -> Bool
stInFigure :: Bool
  , WriterState -> Bool
stInTable :: Bool
  }

type TW = StateT WriterState

withFewerColumns :: PandocMonad m => Int -> TW m a -> TW m a
withFewerColumns :: forall (m :: * -> *) a. PandocMonad m => Int -> TW m a -> TW m a
withFewerColumns Int
n TW m a
a = do
  Int
cols <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stColumns
  Bool
inner <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInner
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stColumns = max (cols - n) 4, stInner = True}
  a
result <- TW m a
a
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stColumns = cols, stInner = inner}
  a -> TW m a
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Convert Pandoc to ANSI
writeANSI :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeANSI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeANSI WriterOptions
opts Pandoc
document =
  StateT WriterState m Text -> WriterState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions -> Pandoc -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> TW m Text
pandocToANSI WriterOptions
opts Pandoc
document)
            WriterState { stNotes :: [Doc Text]
stNotes = [],
                          stColumns :: Int
stColumns = (WriterOptions -> Int
writerColumns WriterOptions
opts),
                          stInner :: Bool
stInner = Bool
False,
                          stNextFigureNum :: Int
stNextFigureNum = Int
1,
                          stInFigure :: Bool
stInFigure = Bool
False,
                          stInTable :: Bool
stInTable = Bool
False
                        }

-- | Return ANSI-styled version of document
pandocToANSI :: PandocMonad m
                => WriterOptions -> Pandoc -> TW m Text
pandocToANSI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> TW m Text
pandocToANSI WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  Context Text
metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
                 (WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts)
                 (WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts) Meta
meta
  Int
width <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stColumns
  let title :: Doc Text
title = Int -> Context Text -> Doc Text
titleBlock Int
width Context Text
metadata
  let blocks' :: [Block]
blocks' = Bool -> Maybe Int -> [Block] -> [Block]
makeSections (WriterOptions -> Bool
writerNumberSections WriterOptions
opts) Maybe Int
forall a. Maybe a
Nothing [Block]
blocks
  Doc Text
body <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts [Block]
blocks'
  [Doc Text]
notes <- (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text])
-> (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> [Doc Text]
forall a. [a] -> [a]
reverse ([Doc Text] -> [Doc Text])
-> (WriterState -> [Doc Text]) -> WriterState -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [Doc Text]
stNotes
  let notemark :: Int -> Doc Text
notemark Int
x = Text -> Doc Text
forall a. HasChars a => a -> Doc a
D.literal (Int -> Text
forall a. Show a => a -> Text
tshow (Int
x :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
forall a. Doc a
D.space
  let marks :: [Doc Text]
marks = (Int -> Doc Text) -> [Int] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc Text
notemark [Int
1..[Doc Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
notes]
  let hangWidth :: Int
hangWidth = (Doc Text -> Int -> Int) -> Int -> [Doc Text] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int) -> (Doc Text -> Int) -> Doc Text -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
D.offset) Int
0 [Doc Text]
marks
  let notepretty :: Doc Text
notepretty | Bool -> Bool
not ([Doc Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
notes) = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
D.cblock Int
width Doc Text
forall a. HasChars a => Doc a
hr Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Int -> [Doc Text] -> [Doc Text] -> Doc Text
hangMarks Int
hangWidth [Doc Text]
marks [Doc Text]
notes
                 | Bool
otherwise = Doc Text
forall a. Doc a
D.empty
  let main :: Doc Text
main = Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
notepretty
  let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"titleblock" Doc Text
title Context Text
metadata
  Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
         Maybe (Template Text)
Nothing  -> LazyText -> Text
toStrict (LazyText -> Text) -> LazyText -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> LazyText
forall a. HasChars a => Maybe Int -> Doc a -> LazyText
D.renderANSI (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
width) Doc Text
main
         Just Template Text
tpl -> LazyText -> Text
toStrict (LazyText -> Text) -> LazyText -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> LazyText
forall a. HasChars a => Maybe Int -> Doc a -> LazyText
D.renderANSI (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
width) (Doc Text -> LazyText) -> Doc Text -> LazyText
forall a b. (a -> b) -> a -> b
$ Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

titleBlock :: Int -> Context Text -> D.Doc Text
titleBlock :: Int -> Context Text -> Doc Text
titleBlock Int
width Context Text
meta = if Doc Text -> Bool
forall a. Doc a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Doc Text
most then Doc Text
forall a. Doc a
D.empty else Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
D.cblock Int
width (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
most Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
forall a. HasChars a => Doc a
hr
  where
    title :: Doc Text
title = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.bold (Doc Text -> Maybe (Doc Text) -> Doc Text
forall a. a -> Maybe a -> a
fromMaybe Doc Text
forall a. Doc a
D.empty (Maybe (Doc Text) -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"title" Context Text
meta)
    subtitle :: Doc Text
subtitle = Doc Text -> Maybe (Doc Text) -> Doc Text
forall a. a -> Maybe a -> a
fromMaybe Doc Text
forall a. Doc a
D.empty (Maybe (Doc Text) -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"subtitle" Context Text
meta
    author :: Doc Text
author =  [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Maybe [Doc Text] -> [Doc Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Doc Text] -> [Doc Text]) -> Maybe [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe [Doc Text]
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"author" Context Text
meta
    date :: Doc Text
date = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.italic (Doc Text -> Maybe (Doc Text) -> Doc Text
forall a. a -> Maybe a -> a
fromMaybe Doc Text
forall a. Doc a
D.empty (Maybe (Doc Text) -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"date" Context Text
meta)
    most :: Doc Text
most = (Doc Text
title Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
subtitle) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
author Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
date

hangMarks :: Int -> [D.Doc Text] -> [D.Doc Text] -> D.Doc Text
hangMarks :: Int -> [Doc Text] -> [Doc Text] -> Doc Text
hangMarks Int
width [Doc Text]
markers [Doc Text]
contents =
  [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.vsep ((Doc Text -> Doc Text -> Doc Text)
-> [Doc Text] -> [Doc Text] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc Text -> Doc Text -> Doc Text
forall {a}. HasChars a => Doc a -> Doc a -> Doc a
hangMark [Doc Text]
markers [Doc Text]
contents) where
    hangMark :: Doc a -> Doc a -> Doc a
hangMark Doc a
m Doc a
d = Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
D.rblock Int
width Doc a
m Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Int -> Doc a -> Doc a
forall a. IsString a => Int -> Doc a -> Doc a
D.nest (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Doc a
d

stackMarks :: [D.Doc Text] -> [D.Doc Text] -> D.Doc Text
stackMarks :: [Doc Text] -> [Doc Text] -> Doc Text
stackMarks [Doc Text]
markers [Doc Text]
contents = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.vsep ((Doc Text -> Doc Text -> Doc Text)
-> [Doc Text] -> [Doc Text] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc Text -> Doc Text -> Doc Text
forall {a}. IsString a => Doc a -> Doc a -> Doc a
stack [Doc Text]
markers [Doc Text]
contents)
  where stack :: Doc a -> Doc a -> Doc a
stack Doc a
m Doc a
d = Doc a
m Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc a -> Doc a
forall a. IsString a => Int -> Doc a -> Doc a
D.nest Int
4 Doc a
d

-- | Convert Pandoc block element to ANSI
blockToANSI :: PandocMonad m
               => WriterOptions -- ^ Options
               -> Block         -- ^ Block element
               -> TW m (D.Doc Text)

blockToANSI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> TW m (Doc Text)
blockToANSI WriterOptions
opts (Div Attr
_ [Block]
bs) = WriterOptions -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts [Block]
bs

blockToANSI WriterOptions
opts (Plain [Inline]
inlines) = WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
inlines

blockToANSI WriterOptions
opts (Para [Inline]
inlines) = WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
inlines

blockToANSI WriterOptions
opts (LineBlock [[Inline]]
lns) = do
  let go :: [Inline] -> StateT WriterState m (Doc Text)
go [] = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
D.blankline
      go [Inline]
xs = WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
xs
  [Doc Text]
lns' <- ([Inline] -> TW m (Doc Text))
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> TW m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
[Inline] -> StateT WriterState m (Doc Text)
go [[Inline]]
lns
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.vcat [Doc Text]
lns'

blockToANSI WriterOptions
_ b :: Block
b@(RawBlock Format
_ Text
_) = do
    LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
    Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
D.empty

blockToANSI WriterOptions
_ Block
HorizontalRule = Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
D.blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. HasChars a => Doc a
hr Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
D.blankline

blockToANSI WriterOptions
opts (Header Int
level (Text
_, [Text]
classes, [(Text, Text)]
kvs) [Inline]
inlines) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
inlines
  let secnum :: Text
secnum = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs
  let doNumber :: Bool
doNumber = WriterOptions -> Bool
writerNumberSections WriterOptions
opts Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
secnum) Bool -> Bool -> Bool
&& Text
"unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes
  let number :: Doc Text -> Doc Text
number | Bool
doNumber = Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
D.hang (Text -> Int
forall a. HasChars a => a -> Int
D.realLength Text
secnum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Doc Text -> Doc Text
forall {a}. (Eq a, Num a) => a -> Doc Text -> Doc Text
header Int
level (Text -> Doc Text
forall a. HasChars a => a -> Doc a
D.literal Text
secnum) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
D.space)
             | Bool
otherwise = Doc Text -> Doc Text
forall a. a -> a
id
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
number (Int -> Doc Text -> Doc Text
forall {a}. (Eq a, Num a) => a -> Doc Text -> Doc Text
header Int
level Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
D.blankline where
    header :: a -> Doc Text -> Doc Text
header a
1 = ((Text -> Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.toUpper) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.bold
    header a
2 = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.bold
    header a
_ = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.italic

-- The approach to code blocks and highlighting here is a best-effort with
-- existing tools. The Skylighting formatANSI function produces fully-rendered
-- results, and its line numbers are followed by a tab character, which can
-- produce less-than-ideal results depending on your terminal's tab stops. (See
-- tabs(1)). A more ambitious approach here could process SourceLines into a
-- Doc Text.
blockToANSI WriterOptions
opts (CodeBlock Attr
attr Text
str) = do
  Bool
table <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
  Doc Text
inner <- case (Bool
table, WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts) of
    (Bool
_, Maybe Style
Nothing) -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
defaultStyle Text
str
    (Bool
True, Maybe Style
_) -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
defaultStyle Text
str
    (Bool
False, Just Style
s) -> do
      let fmt :: FormatOptions -> [SourceLine] -> Text
fmt FormatOptions
o = FormatOptions -> Style -> [SourceLine] -> Text
formatANSI FormatOptions
o Style
s
          result :: Either Text Text
result = SyntaxMap
-> (FormatOptions -> [SourceLine] -> Text)
-> Attr
-> Text
-> Either Text Text
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts) FormatOptions -> [SourceLine] -> Text
fmt Attr
attr Text
str
      Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ case Either Text Text
result of
        Left Text
_ -> Text -> Doc Text
defaultStyle Text
str
        Right Text
f -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
D.literal Text
f
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Doc Text -> Doc Text
forall {a}. IsString a => Bool -> Doc a -> Doc a
nest Bool
table Doc Text
inner
  where defaultStyle :: Text -> Doc Text
defaultStyle = (Color -> Doc Text -> Doc Text
forall a. HasChars a => Color -> Doc a -> Doc a
D.fg Color
D.red) (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
D.literal
        nest :: Bool -> Doc a -> Doc a
nest Bool
False = Int -> Doc a -> Doc a
forall a. IsString a => Int -> Doc a -> Doc a
D.nest Int
4
        nest Bool
True = Doc a -> Doc a
forall a. a -> a
id

blockToANSI WriterOptions
opts (BlockQuote [Block]
blocks) = do
  Doc Text
contents <- Int -> TW m (Doc Text) -> TW m (Doc Text)
forall (m :: * -> *) a. PandocMonad m => Int -> TW m a -> TW m a
withFewerColumns Int
2 (TW m (Doc Text) -> TW m (Doc Text))
-> TW m (Doc Text) -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts [Block]
blocks
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
D.prefixed String
"│ " Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
D.blankline)

-- TODO: Row spans don't work
blockToANSI WriterOptions
opts (Table Attr
_ (Caption Maybe [Inline]
_ [Block]
caption) [ColSpec]
colSpecs (TableHead Attr
_ [Row]
thead) [TableBody]
tbody (TableFoot Attr
_ [Row]
tfoot)) = do
  let captionInlines :: [Inline]
captionInlines = [Block] -> [Inline]
blocksToInlines [Block]
caption
  Doc Text
captionMarkup <-
    if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
captionInlines
       then Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
       else Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
D.nest Int
2 (Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts ([Block] -> [Inline]
blocksToInlines [Block]
caption)
  Bool
wasTable <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInTable = True}
  let tw :: Int
tw = WriterOptions -> Int
writerColumns WriterOptions
opts
  let ncol :: Int
ncol = [ColSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
colSpecs
  let inWidths :: [ColWidth]
inWidths = (ColSpec -> ColWidth) -> [ColSpec] -> [ColWidth]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> ColWidth
forall a b. (a, b) -> b
snd [ColSpec]
colSpecs
  let spaceForColumns :: Int
spaceForColumns = Int
tw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ncol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1  -- reserve a 1-char gutter between tcols
  let claimWidth :: ColWidth -> a
claimWidth ColWidth
ColWidthDefault = a
0
      claimWidth (ColWidth Double
n) = Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
spaceForColumns)
  let usedSpace :: Int
usedSpace = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ColWidth -> Int) -> [ColWidth] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ColWidth -> Int
forall {a}. Integral a => ColWidth -> a
claimWidth [ColWidth]
inWidths)
  let remaining :: Int
remaining = Int
spaceForColumns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
usedSpace
  let defWidth :: Int
defWidth = Int
remaining Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [ColWidth] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((ColWidth -> Bool) -> [ColWidth] -> [ColWidth]
forall a. (a -> Bool) -> [a] -> [a]
filter (ColWidth -> ColWidth -> Bool
forall a. Eq a => a -> a -> Bool
== ColWidth
ColWidthDefault) [ColWidth]
inWidths)
  let maxWidth :: ColWidth -> Int
maxWidth ColWidth
ColWidthDefault = Int
defWidth
      maxWidth ColWidth
k = ColWidth -> Int
forall {a}. Integral a => ColWidth -> a
claimWidth ColWidth
k
  let widths :: [Int]
widths = (ColWidth -> Int) -> [ColWidth] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ColWidth -> Int
maxWidth [ColWidth]
inWidths
  let decor :: [Doc Text]
decor = [[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.hsep ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Int -> Doc Text) -> [Int] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc Text
forall a. HasChars a => Int -> Doc a
rule [Int]
widths]
  [Doc Text]
head' <- (Row -> TW m (Doc Text))
-> [Row] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Int] -> [Cell] -> TW m (Doc Text)
forall {m :: * -> *} {t :: * -> *}.
(Foldable t, PandocMonad m) =>
[Int] -> t Cell -> StateT WriterState m (Doc Text)
goRow [Int]
widths ([Cell] -> TW m (Doc Text))
-> (Row -> [Cell]) -> Row -> TW m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Row -> [Cell]
unRow) [Row]
thead
  [Doc Text]
body' <- (Row -> TW m (Doc Text))
-> [Row] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Int] -> [Cell] -> TW m (Doc Text)
forall {m :: * -> *} {t :: * -> *}.
(Foldable t, PandocMonad m) =>
[Int] -> t Cell -> StateT WriterState m (Doc Text)
goRow [Int]
widths ([Cell] -> TW m (Doc Text))
-> (Row -> [Cell]) -> Row -> TW m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Row -> [Cell]
unRow) ([TableBody] -> [Row]
unBodies [TableBody]
tbody)
  [Doc Text]
foot' <- (Row -> TW m (Doc Text))
-> [Row] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Int] -> [Cell] -> TW m (Doc Text)
forall {m :: * -> *} {t :: * -> *}.
(Foldable t, PandocMonad m) =>
[Int] -> t Cell -> StateT WriterState m (Doc Text)
goRow [Int]
widths ([Cell] -> TW m (Doc Text))
-> (Row -> [Cell]) -> Row -> TW m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Row -> [Cell]
unRow) [Row]
tfoot
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInTable = wasTable}
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.vcat ([Doc Text]
head' [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. Semigroup a => a -> a -> a
<> [Doc Text]
decor [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. Semigroup a => a -> a -> a
<> [Doc Text]
body' [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. Semigroup a => a -> a -> a
<> [Doc Text]
decor [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. Semigroup a => a -> a -> a
<> [Doc Text]
foot') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
captionMarkup
  where
    unRow :: Row -> [Cell]
unRow (Row Attr
_ [Cell]
cs) = [Cell]
cs
    unBody :: TableBody -> [Row]
unBody (TableBody Attr
_ RowHeadColumns
_ [Row]
hd [Row]
bd) = [Row]
hd [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [Row]
bd
    unBodies :: [TableBody] -> [Row]
unBodies = (TableBody -> [Row]) -> [TableBody] -> [Row]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TableBody -> [Row]
unBody
    goRow :: [Int] -> t Cell -> StateT WriterState m (Doc Text)
goRow [Int]
ws t Cell
cs = do
      ([Doc Text]
d, [Int]
_) <- (([Doc Text], [Int])
 -> Cell -> StateT WriterState m ([Doc Text], [Int]))
-> ([Doc Text], [Int])
-> t Cell
-> StateT WriterState m ([Doc Text], [Int])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Doc Text], [Int])
-> Cell -> StateT WriterState m ([Doc Text], [Int])
forall {m :: * -> *}.
PandocMonad m =>
([Doc Text], [Int])
-> Cell -> StateT WriterState m ([Doc Text], [Int])
goCell ([], [Int]
ws) t Cell
cs
      Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.hcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Doc Text
forall a. HasChars a => a -> Doc a
D.vfill Text
" ") ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> [Doc Text]
forall a. [a] -> [a]
reverse [Doc Text]
d
    goCell :: ([Doc Text], [Int])
-> Cell -> StateT WriterState m ([Doc Text], [Int])
goCell ([Doc Text]
r, [Int]
ws) (Cell Attr
_ Alignment
aln RowSpan
_ (ColSpan Int
cspan) [Block]
inner) = do
      let ([Int]
ws', Doc Text -> Doc Text
render) = [Int] -> Alignment -> Int -> ([Int], Doc Text -> Doc Text)
forall {a}.
HasChars a =>
[Int] -> Alignment -> Int -> ([Int], Doc a -> Doc a)
next [Int]
ws Alignment
aln Int
cspan
      Doc Text
innerDoc <- WriterOptions -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts [Block]
inner
      ([Doc Text], [Int]) -> StateT WriterState m ([Doc Text], [Int])
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Doc Text -> Doc Text
render Doc Text
innerDoc)Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
:[Doc Text]
r, [Int]
ws')
    tcell :: Alignment -> Int -> Doc a -> Doc a
tcell Alignment
AlignLeft    = Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
D.lblock
    tcell Alignment
AlignRight   = Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
D.rblock
    tcell Alignment
AlignCenter  = Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
D.cblock
    tcell Alignment
AlignDefault = Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
D.lblock
    next :: [Int] -> Alignment -> Int -> ([Int], Doc a -> Doc a)
next [Int]
ws Alignment
aln Int
cspan =
      let ([Int]
this, [Int]
ws') = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
cspan [Int]
ws
          w :: Int
w = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
this Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cspan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          cell :: Doc a -> Doc a
cell = (Alignment -> Int -> Doc a -> Doc a
forall {a}. HasChars a => Alignment -> Int -> Doc a -> Doc a
tcell Alignment
aln) Int
w
       in ([Int]
ws', Doc a -> Doc a
cell)

blockToANSI WriterOptions
opts (BulletList [[Block]]
items) = do
  [Doc Text]
contents <- Int
-> StateT WriterState m [Doc Text]
-> StateT WriterState m [Doc Text]
forall (m :: * -> *) a. PandocMonad m => Int -> TW m a -> TW m a
withFewerColumns Int
2 (StateT WriterState m [Doc Text]
 -> StateT WriterState m [Doc Text])
-> StateT WriterState m [Doc Text]
-> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ ([Block] -> TW m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts) [[Block]]
items
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.vsep ((Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
hangMark [Doc Text]
contents) where
    hangMark :: Doc a -> Doc a
hangMark Doc a
d = Int -> Doc a -> Doc a -> Doc a
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
D.hang Int
2 (a -> Doc a
forall a. HasChars a => a -> Doc a
D.literal a
"• ") Doc a
d

blockToANSI WriterOptions
opts (OrderedList ListAttributes
attribs [[Block]]
items) = do
  let markers :: [Doc Text]
markers = (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Doc Text
forall a. HasChars a => a -> Doc a
D.literal ([Text] -> [Doc Text]) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Text]
orderedListMarkers ListAttributes
attribs
  let hangWidth :: Int
hangWidth = (Doc Text -> Int -> Int) -> Int -> [Doc Text] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int) -> (Doc Text -> Int) -> Doc Text -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
D.offset) Int
0 [Doc Text]
markers
  [Doc Text]
contents <- Int
-> StateT WriterState m [Doc Text]
-> StateT WriterState m [Doc Text]
forall (m :: * -> *) a. PandocMonad m => Int -> TW m a -> TW m a
withFewerColumns Int
hangWidth (StateT WriterState m [Doc Text]
 -> StateT WriterState m [Doc Text])
-> StateT WriterState m [Doc Text]
-> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ ([Block] -> TW m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts) [[Block]]
items
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> [Doc Text] -> [Doc Text] -> Doc Text
hangMarks Int
hangWidth [Doc Text]
markers [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
D.cr

blockToANSI WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
  [Doc Text]
labels <- (([Inline], [[Block]]) -> TW m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts ([Inline] -> TW m (Doc Text))
-> (([Inline], [[Block]]) -> [Inline])
-> ([Inline], [[Block]])
-> TW m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline], [[Block]]) -> [Inline]
forall a b. (a, b) -> a
fst) [([Inline], [[Block]])]
items
  Int
columns <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stColumns
  let hangWidth :: Int
hangWidth = (Doc Text -> Int -> Int) -> Int -> [Doc Text] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int) -> (Doc Text -> Int) -> Doc Text -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
D.offset) Int
0 [Doc Text]
labels
  if Int
hangWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
columns Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
10 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
3)
     then do
       [[Doc Text]]
contents <- Int -> TW m [[Doc Text]] -> TW m [[Doc Text]]
forall (m :: * -> *) a. PandocMonad m => Int -> TW m a -> TW m a
withFewerColumns Int
4 (TW m [[Doc Text]] -> TW m [[Doc Text]])
-> TW m [[Doc Text]] -> TW m [[Doc Text]]
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> StateT WriterState m [Doc Text])
-> [([Inline], [[Block]])] -> TW m [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((([Block] -> TW m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts)) ([[Block]] -> StateT WriterState m [Doc Text])
-> (([Inline], [[Block]]) -> [[Block]])
-> ([Inline], [[Block]])
-> StateT WriterState m [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline], [[Block]]) -> [[Block]]
forall a b. (a, b) -> b
snd) [([Inline], [[Block]])]
items
       Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> [Doc Text] -> Doc Text
stackMarks (Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.bold (Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Doc Text]
labels) ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.vsep ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Doc Text]]
contents) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
D.cr
     else do
       [[Doc Text]]
contents <- Int -> TW m [[Doc Text]] -> TW m [[Doc Text]]
forall (m :: * -> *) a. PandocMonad m => Int -> TW m a -> TW m a
withFewerColumns Int
hangWidth (TW m [[Doc Text]] -> TW m [[Doc Text]])
-> TW m [[Doc Text]] -> TW m [[Doc Text]]
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> StateT WriterState m [Doc Text])
-> [([Inline], [[Block]])] -> TW m [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((([Block] -> TW m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts)) ([[Block]] -> StateT WriterState m [Doc Text])
-> (([Inline], [[Block]]) -> [[Block]])
-> ([Inline], [[Block]])
-> StateT WriterState m [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline], [[Block]]) -> [[Block]]
forall a b. (a, b) -> b
snd) [([Inline], [[Block]])]
items
       Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> [Doc Text] -> [Doc Text] -> Doc Text
hangMarks Int
hangWidth (Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.bold (Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Doc Text]
labels) ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.vsep ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Doc Text]]
contents) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
D.cr

blockToANSI WriterOptions
opts (Figure Attr
_ (Caption Maybe [Inline]
_ [Block]
caption)  [Block]
body) = do
  let captionInlines :: [Inline]
captionInlines = [Block] -> [Inline]
blocksToInlines [Block]
caption
  Bool
figState <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInFigure
  Doc Text
captionMarkup <-
    if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
captionInlines
       then Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
       else Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
D.nest Int
2 (Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts ([Block] -> [Inline]
blocksToInlines [Block]
caption)
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInFigure = True}
  Doc Text
contents <- WriterOptions -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts [Block]
body
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInFigure = figState}
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts [Block]
blocks =
  [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.vsep ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> TW m (Doc Text)
blockToANSI WriterOptions
opts) [Block]
blocks

-- | Convert list of Pandoc inline elements to ANSI
inlineListToANSI :: PandocMonad m
                    => WriterOptions -> [Inline] -> TW m (D.Doc Text)
inlineListToANSI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst =
  [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.hcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT WriterState m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> TW m (Doc Text)
inlineToANSI WriterOptions
opts) [Inline]
lst

-- | Convert Pandoc inline element to ANSI
inlineToANSI :: PandocMonad m => WriterOptions -> Inline -> TW m (D.Doc Text)

inlineToANSI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> TW m (Doc Text)
inlineToANSI WriterOptions
opts (Span Attr
_ [Inline]
lst) =
  WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst

inlineToANSI WriterOptions
opts (Emph [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.italic Doc Text
contents

inlineToANSI WriterOptions
opts (Underline [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.underlined Doc Text
contents

inlineToANSI WriterOptions
opts (Strong [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.bold Doc Text
contents

inlineToANSI WriterOptions
opts (Strikeout [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.strikeout Doc Text
contents

inlineToANSI WriterOptions
opts (Superscript [Inline]
lst) = do
  case (Inline -> Maybe Inline) -> [Inline] -> Maybe [Inline]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Inline -> Maybe Inline
toSuperscriptInline [Inline]
lst of
    Just [Inline]
xs -> WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
xs
    Maybe [Inline]
Nothing -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.parens (Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst

inlineToANSI WriterOptions
opts (Subscript [Inline]
lst) = do
  case (Inline -> Maybe Inline) -> [Inline] -> Maybe [Inline]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Inline -> Maybe Inline
toSubscriptInline [Inline]
lst of
    Just [Inline]
xs -> WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
xs
    Maybe [Inline]
Nothing -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.parens (Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst

inlineToANSI WriterOptions
opts (SmallCaps [Inline]
lst) = WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst

inlineToANSI WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"‘" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"’"

inlineToANSI WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"“" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"”"

inlineToANSI WriterOptions
opts (Cite [Citation]
_  [Inline]
lst) = WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
lst

-- Making a judgment call here that for ANSI-formatted output
-- intended for reading, we want to reflow inline Code on spaces
inlineToANSI WriterOptions
_ (Code Attr
_ Text
str) =
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Color -> Doc Text -> Doc Text
forall a. HasChars a => Color -> Doc a -> Doc a
D.bg Color
D.white (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Color -> Doc Text -> Doc Text
forall a. HasChars a => Color -> Doc a -> Doc a
D.fg Color
D.red (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
" " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
D.hcat [Doc Text]
flow Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" "
    where flow :: [Doc Text]
flow = Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
forall a. Doc a
D.space (Text -> Doc Text
forall a. HasChars a => a -> Doc a
D.literal (Text -> Doc Text) -> [Text] -> [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.words Text
str)

inlineToANSI WriterOptions
_ (Str Text
str) = Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
D.literal Text
str

inlineToANSI WriterOptions
opts (Math MathType
t Text
str) = MathType -> Text -> StateT WriterState m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str StateT WriterState m [Inline]
-> ([Inline] -> TW m (Doc Text)) -> TW m (Doc Text)
forall a b.
StateT WriterState m a
-> (a -> StateT WriterState m b) -> StateT WriterState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts

inlineToANSI WriterOptions
_ il :: Inline
il@RawInline{} = do
  LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
""

inlineToANSI WriterOptions
_ Inline
LineBreak = Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
D.cr

inlineToANSI WriterOptions
_ Inline
SoftBreak = Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
D.space

inlineToANSI WriterOptions
_ Inline
Space = Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
D.space

inlineToANSI WriterOptions
opts (Link (Text
_, [Text]
_, [(Text, Text)]
_) [Inline]
txt (Text
src, Text
_)) = do
  Doc Text
label <- WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
txt
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.underlined (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Color -> Doc Text -> Doc Text
forall a. HasChars a => Color -> Doc a -> Doc a
D.fg Color
D.cyan (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. HasChars a => Text -> Doc a -> Doc a
D.link Text
src Doc Text
label

inlineToANSI WriterOptions
opts (Image Attr
_ [Inline]
alt (Text, Text)
_) = do
  Bool
infig <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInFigure
  if Bool -> Bool
not Bool
infig then do
    Doc Text
alt' <- WriterOptions -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m (Doc Text)
inlineListToANSI WriterOptions
opts [Inline]
alt
    Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.brackets (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
"image: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
alt'
  else Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
D.brackets Doc Text
"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 WriterOptions
opts (Note [Block]
contents) = do
  [Doc Text]
curNotes <- (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stNotes
  let newnum :: Text
newnum = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
curNotes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  Doc Text
contents' <- WriterOptions -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m (Doc Text)
blockListToANSI WriterOptions
opts [Block]
contents
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stNotes = contents' : curNotes }
  let super :: Maybe Text
super = String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Maybe Char) -> String -> Maybe String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Char -> Maybe Char
toSuperscript (Text -> String
T.unpack Text
newnum))
  Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
D.literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newnum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Maybe Text
super