{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{- |
   Module      : Text.Pandoc.Lua.Writer.Classic
   Copyright   : Copyright (C) 2012-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Conversion of Pandoc documents using a \"classic\" custom Lua writer.
-}
module Text.Pandoc.Lua.Writer.Classic
  ( runCustom
  ) where
import Control.Applicative (optional)
import Control.Arrow ((***))
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text (Text, pack)
import HsLua as Lua hiding (Operation (Div))
#if !MIN_VERSION_hslua(2,2,0)
import HsLua.Aeson (peekViaJSON)
#endif
import Text.DocLayout (literal, render)
import Text.DocTemplates (Context)
import Text.Pandoc.Definition
import Text.Pandoc.Lua.Marshal.Attr (pushAttributeList)
import Text.Pandoc.Lua.Orphans ()
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared

-- | List of key-value pairs that is pushed to Lua as AttributeList
-- userdata.
newtype AttributeList = AttributeList [(Text, Text)]
instance Pushable AttributeList where
  push :: forall e. LuaError e => AttributeList -> LuaE e ()
push (AttributeList [(Text, Text)]
kvs) = forall e. LuaError e => Pusher e [(Text, Text)]
pushAttributeList [(Text, Text)]
kvs

attrToMap :: Attr -> AttributeList
attrToMap :: Attr -> AttributeList
attrToMap (Text
id',[Text]
classes,[(Text, Text)]
keyvals) = [(Text, Text)] -> AttributeList
AttributeList
    forall a b. (a -> b) -> a -> b
$ (Text
"id", Text
id')
    forall a. a -> [a] -> [a]
: (Text
"class", [Text] -> Text
T.unwords [Text]
classes)
    forall a. a -> [a] -> [a]
: [(Text, Text)]
keyvals

newtype Stringify a = Stringify a

instance Pushable (Stringify Format) where
  push :: forall e. LuaError e => Stringify Format -> LuaE e ()
push (Stringify (Format Text
f)) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (Text -> Text
T.toLower Text
f)

instance Pushable (Stringify [Inline]) where
  push :: forall e. LuaError e => Stringify [Inline] -> LuaE e ()
push (Stringify [Inline]
ils) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. LuaError e => [Inline] -> LuaE e String
inlineListToCustom [Inline]
ils

instance Pushable (Stringify [Block]) where
  push :: forall e. LuaError e => Stringify [Block] -> LuaE e ()
push (Stringify [Block]
blks) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. LuaError e => [Block] -> LuaE e String
blockListToCustom [Block]
blks

instance Pushable (Stringify MetaValue) where
  push :: forall e. LuaError e => Stringify MetaValue -> LuaE e ()
push (Stringify (MetaMap Map Text MetaValue
m))       = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Stringify a
Stringify Map Text MetaValue
m)
  push (Stringify (MetaList [MetaValue]
xs))     = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Stringify a
Stringify [MetaValue]
xs)
  push (Stringify (MetaBool Bool
x))      = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Bool
x
  push (Stringify (MetaString Text
s))    = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Text
s
  push (Stringify (MetaInlines [Inline]
ils)) = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (forall a. a -> Stringify a
Stringify [Inline]
ils)
  push (Stringify (MetaBlocks [Block]
bs))   = forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (forall a. a -> Stringify a
Stringify [Block]
bs)

instance Pushable (Stringify Citation) where
  push :: forall e. LuaError e => Stringify Citation -> LuaE e ()
push (Stringify Citation
cit) = forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
    [ (Name
"citationId", forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Text
citationId)
    , (Name
"citationPrefix",  forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Stringify a
Stringify forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [Inline]
citationPrefix)
    , (Name
"citationSuffix",  forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Stringify a
Stringify forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [Inline]
citationSuffix)
    , (Name
"citationMode",    forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> CitationMode
citationMode)
    , (Name
"citationNoteNum", forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Int
citationNoteNum)
    , (Name
"citationHash",    forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Int
citationHash)
    ]
    Citation
cit

-- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the
-- associated value.
newtype KeyValue a b = KeyValue (a, b)

instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where
  push :: forall e. LuaError e => KeyValue a b -> LuaE e ()
push (KeyValue (a
k, b
v)) = do
    forall e. LuaE e ()
Lua.newtable
    forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push a
k
    forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push b
v
    forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (CInt -> StackIndex
Lua.nth CInt
3)

-- | Convert Pandoc to custom markup using a classic Lua writer.
runCustom :: LuaError e
          => WriterOptions
          -> Pandoc
          -> LuaE e Text
runCustom :: forall e. LuaError e => WriterOptions -> Pandoc -> LuaE e Text
runCustom WriterOptions
opts doc :: Pandoc
doc@(Pandoc Meta
meta [Block]
_) = do
  (Text
body, Context Text
context) <- forall e.
LuaError e =>
WriterOptions -> Pandoc -> LuaE e (Text, Context Text)
docToCustom WriterOptions
opts Pandoc
doc
  -- convert metavalues to a template context (variables)
  Context Text
metaContext <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
                   (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => [Block] -> LuaE e String
blockListToCustom)
                   (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => [Inline] -> LuaE e String
inlineListToCustom)
                   Meta
meta
  -- merge contexts from metadata and variables
  let renderContext :: Context Text
renderContext = Context Text
context forall a. Semigroup a => a -> a -> a
<> Context Text
metaContext
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
    Maybe (Template Text)
Nothing  -> Text
body
    Just Template Text
tpl -> forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
                forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
setField Text
"body" Text
body Context Text
renderContext

-- | Converts a Pandoc value to custom markup using a classic Lua writer.
docToCustom :: forall e. LuaError e
            => WriterOptions -> Pandoc -> LuaE e (Text, Context Text)
docToCustom :: forall e.
LuaError e =>
WriterOptions -> Pandoc -> LuaE e (Text, Context Text)
docToCustom WriterOptions
opts (Pandoc (Meta Map Text MetaValue
metamap) [Block]
blocks) = do
  String
body <- forall e. LuaError e => [Block] -> LuaE e String
blockListToCustom [Block]
blocks
  -- invoke doesn't work with multiple return values, so we have to call
  -- `Doc` manually.
  forall e. LuaError e => Name -> LuaE e Type
Lua.getglobal Name
"Doc"                 -- function
  forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push String
body                           -- argument 1
  forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Stringify a
Stringify  Map Text MetaValue
metamap)      -- argument 2
  forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push (WriterOptions -> Context Text
writerVariables WriterOptions
opts)         -- argument 3
  forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call NumArgs
3 NumResults
2
  Text
rendered  <- forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
peek (CInt -> StackIndex
nth CInt
2)       -- first return value
  Maybe (Context Text)
context <- forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON StackIndex
top  -- snd return value
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
rendered, forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe (Context Text)
context)


-- | Convert Pandoc block element to Custom.
blockToCustom :: forall e. LuaError e
              => Block         -- ^ Block element
              -> LuaE e String

blockToCustom :: forall e. LuaError e => Block -> LuaE e String
blockToCustom (Plain [Inline]
inlines) = forall a. Invokable a => Name -> a
invoke Name
"Plain" (forall a. a -> Stringify a
Stringify [Inline]
inlines)

blockToCustom (Para [Image Attr
attr [Inline]
txt (Text
src,Text
tit)]) =
  forall a. Invokable a => Name -> a
invoke Name
"CaptionedImage" Text
src Text
tit (forall a. a -> Stringify a
Stringify [Inline]
txt) (Attr -> AttributeList
attrToMap Attr
attr)

blockToCustom (Para [Inline]
inlines) = forall a. Invokable a => Name -> a
invoke Name
"Para" (forall a. a -> Stringify a
Stringify [Inline]
inlines)

blockToCustom (LineBlock [[Inline]]
linesList) =
  forall a. Invokable a => Name -> a
invoke Name
"LineBlock" (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [[Inline]]
linesList)

blockToCustom (RawBlock Format
format Text
str) =
  forall a. Invokable a => Name -> a
invoke Name
"RawBlock" (forall a. a -> Stringify a
Stringify Format
format) Text
str

blockToCustom Block
HorizontalRule = forall a. Invokable a => Name -> a
invoke Name
"HorizontalRule"

blockToCustom (Header Int
level Attr
attr [Inline]
inlines) =
  forall a. Invokable a => Name -> a
invoke Name
"Header" Int
level (forall a. a -> Stringify a
Stringify [Inline]
inlines) (Attr -> AttributeList
attrToMap Attr
attr)

blockToCustom (CodeBlock Attr
attr Text
str) =
  forall a. Invokable a => Name -> a
invoke Name
"CodeBlock" Text
str (Attr -> AttributeList
attrToMap Attr
attr)

blockToCustom (BlockQuote [Block]
blocks) =
  forall a. Invokable a => Name -> a
invoke Name
"BlockQuote" (forall a. a -> Stringify a
Stringify [Block]
blocks)

blockToCustom (Figure Attr
attr (Caption Maybe [Inline]
_ [Block]
cbody) [Block]
content) =
  forall a. Invokable a => Name -> a
invoke Name
"Figure"
    (forall a. a -> Stringify a
Stringify [Block]
cbody)
    (forall a. a -> Stringify a
Stringify [Block]
content)
    (Attr -> AttributeList
attrToMap Attr
attr)

blockToCustom (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
  let ([Inline]
capt, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
      aligns' :: [String]
aligns' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Alignment]
aligns
      capt' :: Stringify [Inline]
capt' = forall a. a -> Stringify a
Stringify [Inline]
capt
      headers' :: [Stringify [Block]]
headers' = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [[Block]]
headers
      rows' :: [[Stringify [Block]]]
rows' = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify)) [[[Block]]]
rows
  in forall a. Invokable a => Name -> a
invoke Name
"Table" Stringify [Inline]
capt' [String]
aligns' [Double]
widths [Stringify [Block]]
headers' [[Stringify [Block]]]
rows'

blockToCustom (BulletList [[Block]]
items) =
  forall a. Invokable a => Name -> a
invoke Name
"BulletList" (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [[Block]]
items)

blockToCustom (OrderedList (Int
num,ListNumberStyle
sty,ListNumberDelim
delim) [[Block]]
items) =
  forall a. Invokable a => Name -> a
invoke Name
"OrderedList" (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [[Block]]
items) Int
num (forall a. Show a => a -> String
show ListNumberStyle
sty) (forall a. Show a => a -> String
show ListNumberDelim
delim)

blockToCustom (DefinitionList [([Inline], [[Block]])]
items) =
  forall a. Invokable a => Name -> a
invoke Name
"DefinitionList"
               (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> KeyValue a b
KeyValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Stringify a
Stringify forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify))) [([Inline], [[Block]])]
items)

blockToCustom (Div Attr
attr [Block]
items) =
  forall a. Invokable a => Name -> a
invoke Name
"Div" (forall a. a -> Stringify a
Stringify [Block]
items) (Attr -> AttributeList
attrToMap Attr
attr)

-- | Convert list of Pandoc block elements to Custom.
blockListToCustom :: forall e. LuaError e
                  => [Block]       -- ^ List of block elements
                  -> LuaE e String
blockListToCustom :: forall e. LuaError e => [Block] -> LuaE e String
blockListToCustom [Block]
xs = do
  String
blocksep <- forall a. Invokable a => Name -> a
invoke Name
"Blocksep"
  [String]
bs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall e. LuaError e => Block -> LuaE e String
blockToCustom [Block]
xs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse String
blocksep [String]
bs

-- | Convert list of Pandoc inline elements to Custom.
inlineListToCustom :: forall e. LuaError e => [Inline] -> LuaE e String
inlineListToCustom :: forall e. LuaError e => [Inline] -> LuaE e String
inlineListToCustom [Inline]
lst = do
  [String]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall e. LuaError e => Inline -> LuaE e String
inlineToCustom @e) [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [String]
xs

-- | Convert Pandoc inline element to Custom.
inlineToCustom :: forall e. LuaError e => Inline -> LuaE e String

inlineToCustom :: forall e. LuaError e => Inline -> LuaE e String
inlineToCustom (Str Text
str) = forall a. Invokable a => Name -> a
invoke Name
"Str" Text
str

inlineToCustom Inline
Space = forall a. Invokable a => Name -> a
invoke Name
"Space"

inlineToCustom Inline
SoftBreak = forall a. Invokable a => Name -> a
invoke Name
"SoftBreak"

inlineToCustom (Emph [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Emph" (forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Underline [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Underline" (forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Strong [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Strong" (forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Strikeout [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Strikeout" (forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Superscript [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Superscript" (forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Subscript [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"Subscript" (forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (SmallCaps [Inline]
lst) = forall a. Invokable a => Name -> a
invoke Name
"SmallCaps" (forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Quoted QuoteType
SingleQuote [Inline]
lst) =
  forall a. Invokable a => Name -> a
invoke Name
"SingleQuoted" (forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Quoted QuoteType
DoubleQuote [Inline]
lst) =
  forall a. Invokable a => Name -> a
invoke Name
"DoubleQuoted" (forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Cite [Citation]
cs [Inline]
lst) =
  forall a. Invokable a => Name -> a
invoke Name
"Cite" (forall a. a -> Stringify a
Stringify [Inline]
lst) (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Stringify a
Stringify) [Citation]
cs)

inlineToCustom (Code Attr
attr Text
str) =
  forall a. Invokable a => Name -> a
invoke Name
"Code" Text
str (Attr -> AttributeList
attrToMap Attr
attr)

inlineToCustom (Math MathType
DisplayMath Text
str) =
  forall a. Invokable a => Name -> a
invoke Name
"DisplayMath" Text
str

inlineToCustom (Math MathType
InlineMath Text
str) =
  forall a. Invokable a => Name -> a
invoke Name
"InlineMath" Text
str

inlineToCustom (RawInline Format
format Text
str) =
  forall a. Invokable a => Name -> a
invoke Name
"RawInline" (forall a. a -> Stringify a
Stringify Format
format) Text
str

inlineToCustom Inline
LineBreak = forall a. Invokable a => Name -> a
invoke Name
"LineBreak"

inlineToCustom (Link Attr
attr [Inline]
txt (Text
src,Text
tit)) =
  forall a. Invokable a => Name -> a
invoke Name
"Link" (forall a. a -> Stringify a
Stringify [Inline]
txt) Text
src Text
tit (Attr -> AttributeList
attrToMap Attr
attr)

inlineToCustom (Image Attr
attr [Inline]
alt (Text
src,Text
tit)) =
  forall a. Invokable a => Name -> a
invoke Name
"Image" (forall a. a -> Stringify a
Stringify [Inline]
alt) Text
src Text
tit (Attr -> AttributeList
attrToMap Attr
attr)

inlineToCustom (Note [Block]
contents) = forall a. Invokable a => Name -> a
invoke Name
"Note" (forall a. a -> Stringify a
Stringify [Block]
contents)

inlineToCustom (Span Attr
attr [Inline]
items) =
  forall a. Invokable a => Name -> a
invoke Name
"Span" (forall a. a -> Stringify a
Stringify [Inline]
items) (Attr -> AttributeList
attrToMap Attr
attr)