{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.Native
   Copyright   : Copyright (C) 2006-2020 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.
-}
module Text.Pandoc.Writers.Native ( writeNative )
where
import Data.List (intersperse)
import Data.Text (Text)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options (WrapOption (..), WriterOptions (..))
import Text.DocLayout

prettyList :: [Doc Text] -> Doc Text
prettyList :: [Doc Text] -> Doc Text
prettyList [Doc Text]
ds =
  Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
  [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
",") ([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 b. (a -> b) -> [a] -> [b]
map (Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1) [Doc Text]
ds) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"

-- | Prettyprint Pandoc block element.
prettyBlock :: Block -> Doc Text
prettyBlock :: Block -> Doc Text
prettyBlock (LineBlock [[Inline]]
lines') =
  Doc Text
"LineBlock" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
prettyList (([Inline] -> Doc Text) -> [[Inline]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text)
-> ([Inline] -> String) -> [Inline] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> String
forall a. Show a => a -> String
show) [[Inline]]
lines')
prettyBlock (BlockQuote [Block]
blocks) =
  Doc Text
"BlockQuote" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
prettyList ((Block -> Doc Text) -> [Block] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Doc Text
prettyBlock [Block]
blocks)
prettyBlock (OrderedList ListAttributes
attribs [[Block]]
blockLists) =
  Doc Text
"OrderedList" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (ListAttributes -> String
forall a. Show a => a -> String
show ListAttributes
attribs) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
  [Doc Text] -> Doc Text
prettyList (([Block] -> Doc Text) -> [[Block]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc Text] -> Doc Text
prettyList ([Doc Text] -> Doc Text)
-> ([Block] -> [Doc Text]) -> [Block] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Doc Text) -> [Block] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Doc Text
prettyBlock) [[Block]]
blockLists)
prettyBlock (BulletList [[Block]]
blockLists) =
  Doc Text
"BulletList" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
  [Doc Text] -> Doc Text
prettyList (([Block] -> Doc Text) -> [[Block]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc Text] -> Doc Text
prettyList ([Doc Text] -> Doc Text)
-> ([Block] -> [Doc Text]) -> [Block] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Doc Text) -> [Block] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Doc Text
prettyBlock) [[Block]]
blockLists)
prettyBlock (DefinitionList [([Inline], [[Block]])]
items) = Doc Text
"DefinitionList" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
  [Doc Text] -> Doc Text
prettyList ((([Inline], [[Block]]) -> Doc Text)
-> [([Inline], [[Block]])] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Inline], [[Block]]) -> Doc Text
forall a. Show a => (a, [[Block]]) -> Doc Text
deflistitem [([Inline], [[Block]])]
items)
    where deflistitem :: (a, [[Block]]) -> Doc Text
deflistitem (a
term, [[Block]]
defs) = Doc Text
"(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (a -> String
forall a. Show a => a -> String
show a
term) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"," Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
           Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1 ([Doc Text] -> Doc Text
prettyList ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ([Block] -> Doc Text) -> [[Block]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc Text] -> Doc Text
prettyList ([Doc Text] -> Doc Text)
-> ([Block] -> [Doc Text]) -> [Block] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Doc Text) -> [Block] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Doc Text
prettyBlock) [[Block]]
defs) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
prettyBlock (Table Attr
attr Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
  [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [ Doc Text
"Table "
          , String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Attr -> String
forall a. Show a => a -> String
show Attr
attr)
          , Doc Text
" "
          , Caption -> Doc Text
prettyCaption Caption
blkCapt ] Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
  [Doc Text] -> Doc Text
prettyList ((ColSpec -> Doc Text) -> [ColSpec] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> (ColSpec -> String) -> ColSpec -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColSpec -> String
forall a. Show a => a -> String
show) [ColSpec]
specs) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
  TableHead -> Doc Text
prettyHead TableHead
thead Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
  [TableBody] -> Doc Text
prettyBodies [TableBody]
tbody Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
  TableFoot -> Doc Text
prettyFoot TableFoot
tfoot
  where prettyRows :: [Row] -> Doc Text
prettyRows = [Doc Text] -> Doc Text
prettyList ([Doc Text] -> Doc Text)
-> ([Row] -> [Doc Text]) -> [Row] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row -> Doc Text) -> [Row] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Row -> Doc Text
prettyRow
        prettyRow :: Row -> Doc Text
prettyRow (Row Attr
a [Cell]
body) =
          String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String
"Row " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Attr -> String
forall a. Show a => a -> String
show Attr
a) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
prettyList ((Cell -> Doc Text) -> [Cell] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Doc Text
prettyCell [Cell]
body)
        prettyCell :: Cell -> Doc Text
prettyCell (Cell Attr
a Alignment
ma RowSpan
h ColSpan
w [Block]
b) =
          [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [ Doc Text
"Cell "
                  , String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Attr -> String
forall a. Show a => a -> String
show Attr
a)
                  , Doc Text
" "
                  , String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Alignment -> String
forall a. Show a => a -> String
show Alignment
ma)
                  , Doc Text
" ("
                  , String -> Doc Text
forall a. HasChars a => String -> Doc a
text (RowSpan -> String
forall a. Show a => a -> String
show RowSpan
h)
                  , Doc Text
") ("
                  , String -> Doc Text
forall a. HasChars a => String -> Doc a
text (ColSpan -> String
forall a. Show a => a -> String
show ColSpan
w)
                  , Doc Text
")" ] Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
          [Doc Text] -> Doc Text
prettyList ((Block -> Doc Text) -> [Block] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Doc Text
prettyBlock [Block]
b)
        prettyCaption :: Caption -> Doc Text
prettyCaption (Caption Maybe [Inline]
mshort [Block]
body) =
          Doc Text
"(Caption " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> Maybe [Inline] -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 Maybe [Inline]
mshort String
"") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
prettyList ((Block -> Doc Text) -> [Block] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Doc Text
prettyBlock [Block]
body) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
        prettyHead :: TableHead -> Doc Text
prettyHead (TableHead Attr
thattr [Row]
body)
          = Doc Text
"(TableHead " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Attr -> String
forall a. Show a => a -> String
show Attr
thattr) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Row] -> Doc Text
prettyRows [Row]
body Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
        prettyBody :: TableBody -> Doc Text
prettyBody (TableBody Attr
tbattr RowHeadColumns
rhc [Row]
hd [Row]
bd)
          = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [ Doc Text
"(TableBody "
                    , String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Attr -> String
forall a. Show a => a -> String
show Attr
tbattr)
                    , Doc Text
" ("
                    , String -> Doc Text
forall a. HasChars a => String -> Doc a
text (RowHeadColumns -> String
forall a. Show a => a -> String
show RowHeadColumns
rhc)
                    , Doc Text
")" ] Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Row] -> Doc Text
prettyRows [Row]
hd Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Row] -> Doc Text
prettyRows [Row]
bd Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
        prettyBodies :: [TableBody] -> Doc Text
prettyBodies = [Doc Text] -> Doc Text
prettyList ([Doc Text] -> Doc Text)
-> ([TableBody] -> [Doc Text]) -> [TableBody] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableBody -> Doc Text) -> [TableBody] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map TableBody -> Doc Text
prettyBody
        prettyFoot :: TableFoot -> Doc Text
prettyFoot (TableFoot Attr
tfattr [Row]
body)
          = Doc Text
"(TableFoot " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Attr -> String
forall a. Show a => a -> String
show Attr
tfattr) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Row] -> Doc Text
prettyRows [Row]
body Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
prettyBlock (Div Attr
attr [Block]
blocks) =
  String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String
"Div " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Attr -> String
forall a. Show a => a -> String
show Attr
attr) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
prettyList ((Block -> Doc Text) -> [Block] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Doc Text
prettyBlock [Block]
blocks)
prettyBlock Block
block = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Block -> String
forall a. Show a => a -> String
show Block
block

-- | Prettyprint Pandoc document.
writeNative :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeNative :: WriterOptions -> Pandoc -> m Text
writeNative WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Maybe Int
forall a. Maybe a
Nothing
      withHead :: Doc Text -> Doc Text
withHead = case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
                      Just Template Text
_  -> \Doc Text
bs -> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String
"Pandoc (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Meta -> String
forall a. Show a => a -> String
show Meta
meta String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                                  Doc Text
bs Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
cr
                      Maybe (Template Text)
Nothing -> Doc Text -> Doc Text
forall a. a -> a
id
  in  Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
withHead (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
prettyList ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Block -> Doc Text) -> [Block] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Doc Text
prettyBlock [Block]
blocks