{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.Native
   Copyright   : Copyright (C) 2006-2019 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 Prelude
import Data.List (intersperse)
import Data.Text (Text)
import Text.Pandoc.Class (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 ds :: [Doc Text]
ds =
  "[" 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]
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 1) [Doc Text]
ds) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "]"

-- | Prettyprint Pandoc block element.
prettyBlock :: Block -> Doc Text
prettyBlock :: Block -> Doc Text
prettyBlock (LineBlock lines' :: [[Inline]]
lines') =
  "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 blocks :: [Block]
blocks) =
  "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 attribs :: ListAttributes
attribs blockLists :: [[Block]]
blockLists) =
  "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 blockLists :: [[Block]]
blockLists) =
  "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 items :: [([Inline], [[Block]])]
items) = "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 (term :: a
term, defs :: [[Block]]
defs) = "(" 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
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 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
<> ")"
prettyBlock (Table caption :: [Inline]
caption aligns :: [Alignment]
aligns widths :: [Double]
widths header :: [[Block]]
header rows :: [[[Block]]]
rows) =
  "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
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
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 cols :: [[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
attr blocks :: [Block]
blocks) =
  String -> Doc Text
forall a. HasChars a => String -> Doc a
text ("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
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 opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [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 _  -> \bs :: Doc Text
bs -> String -> Doc Text
forall a. HasChars a => String -> Doc a
text ("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]
++ ")") 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
                      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