{-# 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 [Inline]
caption [Alignment]
aligns [Double]
widths [[Block]]
header [[[Block]]]
rows) =
  Doc Text
"Table " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text ([Inline] -> String
forall a. Show a => a -> String
show [Inline]
caption) 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
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text ([Alignment] -> String
forall a. Show a => a -> String
show [Alignment]
aligns) 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
<>
  String -> Doc Text
forall a. HasChars a => String -> Doc a
text ([Double] -> String
forall a. Show a => a -> String
show [Double]
widths) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
  [[Block]] -> Doc Text
prettyRow [[Block]]
header 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
prettyRow [[[Block]]]
rows)
    where prettyRow :: [[Block]] -> Doc Text
prettyRow [[Block]]
cols = [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]]
cols)
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