{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.Native
   Copyright   : Copyright (C) 2006-2024 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of a 'Pandoc' document to a string representation.

This used to be implemented using pretty-show's 'ppDoc' (which shows
the document, tokenizes and parses the result, and lays it out with
Text.PrettyPrint.HughesPJ).  For performance, we now build the layout
directly from the AST, carefully reproducing the exact output of the
old implementation (with @ribbonsPerLine = 1.2@).
-}
module Text.Pandoc.Writers.Native ( writeNative )
where
import Data.List (intersperse)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions (..))

-- | Prettyprint Pandoc document.
writeNative :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeNative :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeNative WriterOptions
opts doc :: Pandoc
doc@(Pandoc Meta
_ [Block]
blocks) = do
  let cols :: Int
cols = WriterOptions -> Int
writerColumns WriterOptions
opts
  -- HughesPJ computes the ribbon length this way (with Float division):
  let ribbon :: Int
ribbon = Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
1.2 :: Float))
  Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
    -- The old code appended a (char '\n'), which participates in layout
    -- as one extra glued character on the last line; hence glue0 = 1.
    Just Template Text
_  -> Int -> Int -> Int -> Doc -> Text
render Int
cols Int
ribbon Int
1 (V -> Doc
vDoc (Pandoc -> V
pandocV Pandoc
doc)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
    Maybe (Template Text)
Nothing -> Int -> Int -> Int -> Doc -> Text
render Int
cols Int
ribbon Int
0 (V -> Doc
vDoc ([Block] -> V
blocksV [Block]
blocks))

--
-- Layout documents (mirroring the structures pretty-show builds)
--

-- | A document together with the width of its one-line rendering.
data Doc = Doc !Int DC

-- | Either literal text, or a group that is rendered like HughesPJ's
-- 'sep': all on one line (elements joined by single spaces) if it
-- fits, otherwise vertically, with each element after the first on
-- its own line, indented by its nesting relative to the column at
-- which the group starts.
data DC = DText !Text
        | DGroup [Elt]

-- | Group element: nesting, glued prefix text, document, glued suffix.
data Elt = Elt !Int !Text Doc !Text

width :: Doc -> Int
width :: Doc -> Int
width (Doc Int
w DC
_) = Int
w

dtext :: Text -> Doc
dtext :: Text -> Doc
dtext Text
t = Int -> DC -> Doc
Doc (Text -> Int
T.length Text
t) (Text -> DC
DText Text
t)

group :: [Elt] -> Doc
group :: [Elt] -> Doc
group [Elt]
es = Int -> DC -> Doc
Doc ((Int -> Elt -> Int) -> Int -> [Elt] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
acc Elt
e -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Elt -> Int
eltWidth Elt
e) (-Int
1) [Elt]
es) ([Elt] -> DC
DGroup [Elt]
es)
  where eltWidth :: Elt -> Int
eltWidth (Elt Int
_ Text
pre Doc
d Text
post) = Text -> Int
T.length Text
pre Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Doc -> Int
width Doc
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
post

-- | A value, i.e. a document plus an indication of whether it needs
-- parentheses when used as a constructor argument.
data V = V !Bool Doc

vDoc :: V -> Doc
vDoc :: V -> Doc
vDoc (V Bool
_ Doc
d) = Doc
d

-- | Constructor applied to arguments: @hang (text c) 2 (sep args)@,
-- where non-atomic arguments are parenthesized.
con :: Text -> [V] -> V
con :: Text -> [V] -> V
con Text
c [] = Bool -> Doc -> V
V Bool
True (Text -> Doc
dtext Text
c)
con Text
c [V]
vs = Bool -> Doc -> V
V Bool
False (Doc -> V) -> Doc -> V
forall a b. (a -> b) -> a -> b
$ [Elt] -> Doc
group
  [ Int -> Text -> Doc -> Text -> Elt
Elt Int
0 Text
"" (Text -> Doc
dtext Text
c) Text
""
  , Int -> Text -> Doc -> Text -> Elt
Elt Int
2 Text
"" ([Elt] -> Doc
group ((V -> Elt) -> [V] -> [Elt]
forall a b. (a -> b) -> [a] -> [b]
map V -> Elt
atomElt [V]
vs)) Text
"" ]
  where
    atomElt :: V -> Elt
atomElt (V Bool
True Doc
d)  = Int -> Text -> Doc -> Text -> Elt
Elt Int
0 Text
"" Doc
d Text
""
    atomElt (V Bool
False Doc
d) = Int -> Text -> Doc -> Text -> Elt
Elt Int
0 Text
"(" Doc
d Text
")"

-- | Bracketed, comma-separated block: @sep [open <+> x1, ...commas..., close]@.
block :: Text -> Text -> Text -> [Doc] -> Doc
block :: Text -> Text -> Text -> [Doc] -> Doc
block Text
open Text
comma Text
close [Doc]
ds =
  [Elt] -> Doc
group ([Elt] -> Doc) -> [Elt] -> Doc
forall a b. (a -> b) -> a -> b
$ (Text -> Doc -> Elt) -> [Text] -> [Doc] -> [Elt]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
pre Doc
d -> Int -> Text -> Doc -> Text -> Elt
Elt Int
0 Text
pre Doc
d Text
"") (Text
open Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
forall a. a -> [a]
repeat Text
comma) [Doc]
ds
          [Elt] -> [Elt] -> [Elt]
forall a. [a] -> [a] -> [a]
++ [Int -> Text -> Doc -> Text -> Elt
Elt Int
0 Text
"" (Text -> Doc
dtext Text
close) Text
""]

listV :: (a -> V) -> [a] -> V
listV :: forall a. (a -> V) -> [a] -> V
listV a -> V
_ [] = Bool -> Doc -> V
V Bool
True (Text -> Doc
dtext Text
"[]")
listV a -> V
f [a]
xs = Bool -> Doc -> V
V Bool
True (Doc -> V) -> Doc -> V
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Doc] -> Doc
block Text
"[ " Text
", " Text
"]" ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (V -> Doc
vDoc (V -> Doc) -> (a -> V) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> V
f) [a]
xs)

tupleV :: [V] -> V
tupleV :: [V] -> V
tupleV [V]
vs = Bool -> Doc -> V
V Bool
True (Doc -> V) -> Doc -> V
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Doc] -> Doc
block Text
"( " Text
", " Text
")" ((V -> Doc) -> [V] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map V -> Doc
vDoc [V]
vs)

-- | Record: @hang (text c) 2 (block '{' '}' fields)@ where each field
-- is @hang (text name <+> char '=') 2 value@.  Records count as atoms.
recV :: Text -> [(Text, V)] -> V
recV :: Text -> [(Text, V)] -> V
recV Text
c [(Text, V)]
fields = Bool -> Doc -> V
V Bool
True (Doc -> V) -> Doc -> V
forall a b. (a -> b) -> a -> b
$ [Elt] -> Doc
group
  [ Int -> Text -> Doc -> Text -> Elt
Elt Int
0 Text
"" (Text -> Doc
dtext Text
c) Text
""
  , Int -> Text -> Doc -> Text -> Elt
Elt Int
2 Text
"" (Text -> Text -> Text -> [Doc] -> Doc
block Text
"{ " Text
", " Text
"}" (((Text, V) -> Doc) -> [(Text, V)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, V) -> Doc
fieldDoc [(Text, V)]
fields)) Text
"" ]
  where
    fieldDoc :: (Text, V) -> Doc
fieldDoc (Text
name, V
v) = [Elt] -> Doc
group
      [ Int -> Text -> Doc -> Text -> Elt
Elt Int
0 Text
"" (Text -> Doc
dtext (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" =")) Text
""
      , Int -> Text -> Doc -> Text -> Elt
Elt Int
2 Text
"" (V -> Doc
vDoc V
v) Text
"" ]

-- | Leaf rendered via 'show' (Text, Int, Double).  Values whose
-- representation starts with @-@ get parentheses in argument position.
showV :: Show a => a -> V
showV :: forall a. Show a => a -> V
showV a
x = Bool -> Doc -> V
V (Bool -> Bool
not (Text
"-" Text -> Text -> Bool
`T.isPrefixOf` Text
t)) (Text -> Doc
dtext Text
t)
  where t :: Text
t = String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
x)

-- | Nullary constructors of enumeration types (and Bool).
enumV :: Show a => a -> V
enumV :: forall a. Show a => a -> V
enumV = Bool -> Doc -> V
V Bool
True (Doc -> V) -> (a -> Doc) -> a -> V
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
dtext (Text -> Doc) -> (a -> Text) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

mapV :: (a -> V) -> M.Map Text a -> V
mapV :: forall a. (a -> V) -> Map Text a -> V
mapV a -> V
f Map Text a
m = Text -> [V] -> V
con Text
"fromList"
  [((Text, a) -> V) -> [(Text, a)] -> V
forall a. (a -> V) -> [a] -> V
listV (\(Text
k, a
v) -> [V] -> V
tupleV [Text -> V
forall a. Show a => a -> V
showV Text
k, a -> V
f a
v]) (Map Text a -> [(Text, a)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map Text a
m)]

--
-- Conversion of the Pandoc AST
--

pandocV :: Pandoc -> V
pandocV :: Pandoc -> V
pandocV (Pandoc Meta
meta [Block]
blocks) = Text -> [V] -> V
con Text
"Pandoc" [Meta -> V
metaV Meta
meta, [Block] -> V
blocksV [Block]
blocks]

metaV :: Meta -> V
metaV :: Meta -> V
metaV (Meta Map Text MetaValue
m) = Text -> [(Text, V)] -> V
recV Text
"Meta" [(Text
"unMeta", (MetaValue -> V) -> Map Text MetaValue -> V
forall a. (a -> V) -> Map Text a -> V
mapV MetaValue -> V
metaValueV Map Text MetaValue
m)]

metaValueV :: MetaValue -> V
metaValueV :: MetaValue -> V
metaValueV (MetaMap Map Text MetaValue
m)       = Text -> [V] -> V
con Text
"MetaMap" [(MetaValue -> V) -> Map Text MetaValue -> V
forall a. (a -> V) -> Map Text a -> V
mapV MetaValue -> V
metaValueV Map Text MetaValue
m]
metaValueV (MetaList [MetaValue]
xs)     = Text -> [V] -> V
con Text
"MetaList" [(MetaValue -> V) -> [MetaValue] -> V
forall a. (a -> V) -> [a] -> V
listV MetaValue -> V
metaValueV [MetaValue]
xs]
metaValueV (MetaBool Bool
b)      = Text -> [V] -> V
con Text
"MetaBool" [Bool -> V
forall a. Show a => a -> V
enumV Bool
b]
metaValueV (MetaString Text
t)    = Text -> [V] -> V
con Text
"MetaString" [Text -> V
forall a. Show a => a -> V
showV Text
t]
metaValueV (MetaInlines [Inline]
ils) = Text -> [V] -> V
con Text
"MetaInlines" [[Inline] -> V
inlinesV [Inline]
ils]
metaValueV (MetaBlocks [Block]
bs)   = Text -> [V] -> V
con Text
"MetaBlocks" [[Block] -> V
blocksV [Block]
bs]

blocksV :: [Block] -> V
blocksV :: [Block] -> V
blocksV = (Block -> V) -> [Block] -> V
forall a. (a -> V) -> [a] -> V
listV Block -> V
blockV

inlinesV :: [Inline] -> V
inlinesV :: [Inline] -> V
inlinesV = (Inline -> V) -> [Inline] -> V
forall a. (a -> V) -> [a] -> V
listV Inline -> V
inlineV

attrV :: Attr -> V
attrV :: Attr -> V
attrV (Text
ident, [Text]
classes, [(Text, Text)]
kvs) =
  [V] -> V
tupleV [ Text -> V
forall a. Show a => a -> V
showV Text
ident
         , (Text -> V) -> [Text] -> V
forall a. (a -> V) -> [a] -> V
listV Text -> V
forall a. Show a => a -> V
showV [Text]
classes
         , ((Text, Text) -> V) -> [(Text, Text)] -> V
forall a. (a -> V) -> [a] -> V
listV (\(Text
k, Text
v) -> [V] -> V
tupleV [Text -> V
forall a. Show a => a -> V
showV Text
k, Text -> V
forall a. Show a => a -> V
showV Text
v]) [(Text, Text)]
kvs ]

formatV :: Format -> V
formatV :: Format -> V
formatV (Format Text
f) = Text -> [V] -> V
con Text
"Format" [Text -> V
forall a. Show a => a -> V
showV Text
f]

blockV :: Block -> V
blockV :: Block -> V
blockV Block
blk =
  case Block
blk of
    Plain [Inline]
ils -> Text -> [V] -> V
con Text
"Plain" [[Inline] -> V
inlinesV [Inline]
ils]
    Para [Inline]
ils -> Text -> [V] -> V
con Text
"Para" [[Inline] -> V
inlinesV [Inline]
ils]
    LineBlock [[Inline]]
ilss -> Text -> [V] -> V
con Text
"LineBlock" [([Inline] -> V) -> [[Inline]] -> V
forall a. (a -> V) -> [a] -> V
listV [Inline] -> V
inlinesV [[Inline]]
ilss]
    CodeBlock Attr
attr Text
t -> Text -> [V] -> V
con Text
"CodeBlock" [Attr -> V
attrV Attr
attr, Text -> V
forall a. Show a => a -> V
showV Text
t]
    RawBlock Format
f Text
t -> Text -> [V] -> V
con Text
"RawBlock" [Format -> V
formatV Format
f, Text -> V
forall a. Show a => a -> V
showV Text
t]
    BlockQuote [Block]
bs -> Text -> [V] -> V
con Text
"BlockQuote" [[Block] -> V
blocksV [Block]
bs]
    OrderedList (Int
start, ListNumberStyle
sty, ListNumberDelim
delim) [[Block]]
bss ->
      Text -> [V] -> V
con Text
"OrderedList" [ [V] -> V
tupleV [Int -> V
forall a. Show a => a -> V
showV Int
start, ListNumberStyle -> V
forall a. Show a => a -> V
enumV ListNumberStyle
sty, ListNumberDelim -> V
forall a. Show a => a -> V
enumV ListNumberDelim
delim]
                        , ([Block] -> V) -> [[Block]] -> V
forall a. (a -> V) -> [a] -> V
listV [Block] -> V
blocksV [[Block]]
bss ]
    BulletList [[Block]]
bss -> Text -> [V] -> V
con Text
"BulletList" [([Block] -> V) -> [[Block]] -> V
forall a. (a -> V) -> [a] -> V
listV [Block] -> V
blocksV [[Block]]
bss]
    DefinitionList [([Inline], [[Block]])]
defs ->
      Text -> [V] -> V
con Text
"DefinitionList"
        [(([Inline], [[Block]]) -> V) -> [([Inline], [[Block]])] -> V
forall a. (a -> V) -> [a] -> V
listV (\([Inline]
ils, [[Block]]
bss) -> [V] -> V
tupleV [[Inline] -> V
inlinesV [Inline]
ils, ([Block] -> V) -> [[Block]] -> V
forall a. (a -> V) -> [a] -> V
listV [Block] -> V
blocksV [[Block]]
bss]) [([Inline], [[Block]])]
defs]
    Header Int
lev Attr
attr [Inline]
ils -> Text -> [V] -> V
con Text
"Header" [Int -> V
forall a. Show a => a -> V
showV Int
lev, Attr -> V
attrV Attr
attr, [Inline] -> V
inlinesV [Inline]
ils]
    Block
HorizontalRule -> Text -> [V] -> V
con Text
"HorizontalRule" []
    Table Attr
attr Caption
cap [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot ->
      Text -> [V] -> V
con Text
"Table" [ Attr -> V
attrV Attr
attr
                  , Caption -> V
captionV Caption
cap
                  , (ColSpec -> V) -> [ColSpec] -> V
forall a. (a -> V) -> [a] -> V
listV ColSpec -> V
colSpecV [ColSpec]
colspecs
                  , TableHead -> V
tableHeadV TableHead
thead
                  , (TableBody -> V) -> [TableBody] -> V
forall a. (a -> V) -> [a] -> V
listV TableBody -> V
tableBodyV [TableBody]
tbodies
                  , TableFoot -> V
tableFootV TableFoot
tfoot ]
    Figure Attr
attr Caption
cap [Block]
bs -> Text -> [V] -> V
con Text
"Figure" [Attr -> V
attrV Attr
attr, Caption -> V
captionV Caption
cap, [Block] -> V
blocksV [Block]
bs]
    Div Attr
attr [Block]
bs -> Text -> [V] -> V
con Text
"Div" [Attr -> V
attrV Attr
attr, [Block] -> V
blocksV [Block]
bs]

captionV :: Caption -> V
captionV :: Caption -> V
captionV (Caption Maybe [Inline]
mshort [Block]
bs) =
  Text -> [V] -> V
con Text
"Caption" [([Inline] -> V) -> Maybe [Inline] -> V
forall a. (a -> V) -> Maybe a -> V
maybeV [Inline] -> V
inlinesV Maybe [Inline]
mshort, [Block] -> V
blocksV [Block]
bs]

maybeV :: (a -> V) -> Maybe a -> V
maybeV :: forall a. (a -> V) -> Maybe a -> V
maybeV a -> V
_ Maybe a
Nothing  = Text -> [V] -> V
con Text
"Nothing" []
maybeV a -> V
f (Just a
x) = Text -> [V] -> V
con Text
"Just" [a -> V
f a
x]

colSpecV :: ColSpec -> V
colSpecV :: ColSpec -> V
colSpecV (Alignment
align, ColWidth
cw) = [V] -> V
tupleV [Alignment -> V
forall a. Show a => a -> V
enumV Alignment
align, ColWidth -> V
colWidthV ColWidth
cw]

colWidthV :: ColWidth -> V
colWidthV :: ColWidth -> V
colWidthV (ColWidth Double
d)    = Text -> [V] -> V
con Text
"ColWidth" [Double -> V
forall a. Show a => a -> V
showV Double
d]
colWidthV ColWidth
ColWidthDefault = Text -> [V] -> V
con Text
"ColWidthDefault" []

tableHeadV :: TableHead -> V
tableHeadV :: TableHead -> V
tableHeadV (TableHead Attr
attr [Row]
rows) =
  Text -> [V] -> V
con Text
"TableHead" [Attr -> V
attrV Attr
attr, (Row -> V) -> [Row] -> V
forall a. (a -> V) -> [a] -> V
listV Row -> V
rowV [Row]
rows]

tableBodyV :: TableBody -> V
tableBodyV :: TableBody -> V
tableBodyV (TableBody Attr
attr (RowHeadColumns Int
rhc) [Row]
hd [Row]
bd) =
  Text -> [V] -> V
con Text
"TableBody" [ Attr -> V
attrV Attr
attr
                  , Text -> [V] -> V
con Text
"RowHeadColumns" [Int -> V
forall a. Show a => a -> V
showV Int
rhc]
                  , (Row -> V) -> [Row] -> V
forall a. (a -> V) -> [a] -> V
listV Row -> V
rowV [Row]
hd
                  , (Row -> V) -> [Row] -> V
forall a. (a -> V) -> [a] -> V
listV Row -> V
rowV [Row]
bd ]

tableFootV :: TableFoot -> V
tableFootV :: TableFoot -> V
tableFootV (TableFoot Attr
attr [Row]
rows) =
  Text -> [V] -> V
con Text
"TableFoot" [Attr -> V
attrV Attr
attr, (Row -> V) -> [Row] -> V
forall a. (a -> V) -> [a] -> V
listV Row -> V
rowV [Row]
rows]

rowV :: Row -> V
rowV :: Row -> V
rowV (Row Attr
attr [Cell]
cells) = Text -> [V] -> V
con Text
"Row" [Attr -> V
attrV Attr
attr, (Cell -> V) -> [Cell] -> V
forall a. (a -> V) -> [a] -> V
listV Cell -> V
cellV [Cell]
cells]

cellV :: Cell -> V
cellV :: Cell -> V
cellV (Cell Attr
attr Alignment
align (RowSpan Int
rs) (ColSpan Int
cs) [Block]
bs) =
  Text -> [V] -> V
con Text
"Cell" [ Attr -> V
attrV Attr
attr
             , Alignment -> V
forall a. Show a => a -> V
enumV Alignment
align
             , Text -> [V] -> V
con Text
"RowSpan" [Int -> V
forall a. Show a => a -> V
showV Int
rs]
             , Text -> [V] -> V
con Text
"ColSpan" [Int -> V
forall a. Show a => a -> V
showV Int
cs]
             , [Block] -> V
blocksV [Block]
bs ]

inlineV :: Inline -> V
inlineV :: Inline -> V
inlineV Inline
inln =
  case Inline
inln of
    Str Text
t -> Text -> [V] -> V
con Text
"Str" [Text -> V
forall a. Show a => a -> V
showV Text
t]
    Emph [Inline]
ils -> Text -> [V] -> V
con Text
"Emph" [[Inline] -> V
inlinesV [Inline]
ils]
    Underline [Inline]
ils -> Text -> [V] -> V
con Text
"Underline" [[Inline] -> V
inlinesV [Inline]
ils]
    Strong [Inline]
ils -> Text -> [V] -> V
con Text
"Strong" [[Inline] -> V
inlinesV [Inline]
ils]
    Strikeout [Inline]
ils -> Text -> [V] -> V
con Text
"Strikeout" [[Inline] -> V
inlinesV [Inline]
ils]
    Superscript [Inline]
ils -> Text -> [V] -> V
con Text
"Superscript" [[Inline] -> V
inlinesV [Inline]
ils]
    Subscript [Inline]
ils -> Text -> [V] -> V
con Text
"Subscript" [[Inline] -> V
inlinesV [Inline]
ils]
    SmallCaps [Inline]
ils -> Text -> [V] -> V
con Text
"SmallCaps" [[Inline] -> V
inlinesV [Inline]
ils]
    Quoted QuoteType
qt [Inline]
ils -> Text -> [V] -> V
con Text
"Quoted" [QuoteType -> V
forall a. Show a => a -> V
enumV QuoteType
qt, [Inline] -> V
inlinesV [Inline]
ils]
    Cite [Citation]
cits [Inline]
ils -> Text -> [V] -> V
con Text
"Cite" [(Citation -> V) -> [Citation] -> V
forall a. (a -> V) -> [a] -> V
listV Citation -> V
citationV [Citation]
cits, [Inline] -> V
inlinesV [Inline]
ils]
    Code Attr
attr Text
t -> Text -> [V] -> V
con Text
"Code" [Attr -> V
attrV Attr
attr, Text -> V
forall a. Show a => a -> V
showV Text
t]
    Inline
Space -> Text -> [V] -> V
con Text
"Space" []
    Inline
SoftBreak -> Text -> [V] -> V
con Text
"SoftBreak" []
    Inline
LineBreak -> Text -> [V] -> V
con Text
"LineBreak" []
    Math MathType
mt Text
t -> Text -> [V] -> V
con Text
"Math" [MathType -> V
forall a. Show a => a -> V
enumV MathType
mt, Text -> V
forall a. Show a => a -> V
showV Text
t]
    RawInline Format
f Text
t -> Text -> [V] -> V
con Text
"RawInline" [Format -> V
formatV Format
f, Text -> V
forall a. Show a => a -> V
showV Text
t]
    Link Attr
attr [Inline]
ils (Text
url, Text
title) ->
      Text -> [V] -> V
con Text
"Link" [Attr -> V
attrV Attr
attr, [Inline] -> V
inlinesV [Inline]
ils, [V] -> V
tupleV [Text -> V
forall a. Show a => a -> V
showV Text
url, Text -> V
forall a. Show a => a -> V
showV Text
title]]
    Image Attr
attr [Inline]
ils (Text
url, Text
title) ->
      Text -> [V] -> V
con Text
"Image" [Attr -> V
attrV Attr
attr, [Inline] -> V
inlinesV [Inline]
ils, [V] -> V
tupleV [Text -> V
forall a. Show a => a -> V
showV Text
url, Text -> V
forall a. Show a => a -> V
showV Text
title]]
    Note [Block]
bs -> Text -> [V] -> V
con Text
"Note" [[Block] -> V
blocksV [Block]
bs]
    Span Attr
attr [Inline]
ils -> Text -> [V] -> V
con Text
"Span" [Attr -> V
attrV Attr
attr, [Inline] -> V
inlinesV [Inline]
ils]

citationV :: Citation -> V
citationV :: Citation -> V
citationV Citation
cit = Text -> [(Text, V)] -> V
recV Text
"Citation"
  [ (Text
"citationId", Text -> V
forall a. Show a => a -> V
showV (Citation -> Text
citationId Citation
cit))
  , (Text
"citationPrefix", [Inline] -> V
inlinesV (Citation -> [Inline]
citationPrefix Citation
cit))
  , (Text
"citationSuffix", [Inline] -> V
inlinesV (Citation -> [Inline]
citationSuffix Citation
cit))
  , (Text
"citationMode", CitationMode -> V
forall a. Show a => a -> V
enumV (Citation -> CitationMode
citationMode Citation
cit))
  , (Text
"citationNoteNum", Int -> V
forall a. Show a => a -> V
showV (Citation -> Int
citationNoteNum Citation
cit))
  , (Text
"citationHash", Int -> V
forall a. Show a => a -> V
showV (Citation -> Int
citationHash Citation
cit)) ]

--
-- Rendering
--

-- | Render a document, reproducing HughesPJ's layout exactly.  A
-- group is rendered on one line if its width, plus any text glued
-- after it up to the next line break ('glue'), stays within both the
-- line length (measured from the start of the line) and the ribbon
-- length (measured from the end of the indentation).  Otherwise it is
-- rendered vertically, each element after the first starting on a new
-- line, indented by the group's start column plus the element's
-- nesting; each element then makes its own layout decisions.
render :: Int -> Int -> Int -> Doc -> Text
render :: Int -> Int -> Int -> Doc -> Text
render Int
lineLen Int
ribbonLen Int
glue0 Doc
d0 =
  LazyText -> Text
TL.toStrict (LazyText -> Text) -> LazyText -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> LazyText
B.toLazyText (Builder -> LazyText) -> Builder -> LazyText
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Doc -> Builder
go Int
0 Int
0 Int
glue0 Doc
d0
  where
    go :: Int -> Int -> Int -> Doc -> Builder
go Int
l Int
c Int
g d :: Doc
d@(Doc Int
w DC
dc)
      | Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lineLen Bool -> Bool -> Bool
&& (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ribbonLen = Doc -> Builder
flat Doc
d
      | Bool
otherwise =
          case DC
dc of
            DText Text
t   -> Text -> Builder
B.fromText Text
t
            DGroup [Elt]
es -> Int -> Int -> Int -> [Elt] -> Builder
vertical Int
l Int
c Int
g [Elt]
es

    vertical :: Int -> Int -> Int -> [Elt] -> Builder
vertical Int
l0 Int
c0 Int
g = Bool -> [Elt] -> Builder
goElts Bool
True
      where
        goElts :: Bool -> [Elt] -> Builder
goElts Bool
_ [] = Builder
forall a. Monoid a => a
mempty
        goElts Bool
isFirst (Elt Int
n Text
pre Doc
d Text
post : [Elt]
rest) =
          let ind :: Int
ind  = Int
c0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
              (Int
l, Int
c) = if Bool
isFirst then (Int
l0, Int
c0) else (Int
ind, Int
ind)
              g' :: Int
g' = Text -> Int
T.length Text
post Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if [Elt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Elt]
rest then Int
g else Int
0)
              lead :: Builder
lead = if Bool
isFirst
                        then Builder
forall a. Monoid a => a
mempty
                        else Char -> Builder
B.singleton Char
'\n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText (Int -> Text -> Text
T.replicate Int
ind Text
" ")
          in  Builder
lead Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
pre Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Int -> Doc -> Builder
go Int
l (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
pre) Int
g' Doc
d
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
post Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [Elt] -> Builder
goElts Bool
False [Elt]
rest

    flat :: Doc -> Builder
flat (Doc Int
_ (DText Text
t))   = Text -> Builder
B.fromText Text
t
    flat (Doc Int
_ (DGroup [Elt]
es)) =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
B.singleton Char
' ') ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Elt -> Builder) -> [Elt] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Elt -> Builder
flatElt [Elt]
es

    flatElt :: Elt -> Builder
flatElt (Elt Int
_ Text
pre Doc
d Text
post) =
      Text -> Builder
B.fromText Text
pre Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Doc -> Builder
flat Doc
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
post