{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE OverloadedStrings  #-}
{- |
   Module      : Text.Pandoc.Writers.Custom
   Copyright   : Copyright (C) 2012-2020 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Conversion of 'Pandoc' documents to custom markup using
a lua writer.
-}
module Text.Pandoc.Writers.Custom ( writeCustom ) where
import Control.Arrow ((***))
import Control.Exception
import Control.Monad (when)
import Data.List (intersperse)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text, pack)
import Data.Typeable
import Foreign.Lua (Lua, Pushable)
import Text.DocLayout (render, literal)
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Definition
import Text.Pandoc.Lua (Global (..), LuaException (LuaException),
                        runLua, setGlobals)
import Text.Pandoc.Lua.Util (addField, dofileWithTraceback)
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Writers.Shared

import qualified Foreign.Lua as Lua

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

newtype Stringify a = Stringify a

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

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

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

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

instance Pushable (Stringify Citation) where
  push :: Stringify Citation -> Lua ()
push (Stringify cit :: Citation
cit) = do
    Int -> Int -> Lua ()
Lua.createtable 6 0
    String -> Text -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
addField "citationId" (Text -> Lua ()) -> Text -> Lua ()
forall a b. (a -> b) -> a -> b
$ Citation -> Text
citationId Citation
cit
    String -> Stringify [Inline] -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
addField "citationPrefix" (Stringify [Inline] -> Lua ())
-> ([Inline] -> Stringify [Inline]) -> [Inline] -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify ([Inline] -> Lua ()) -> [Inline] -> Lua ()
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationPrefix Citation
cit
    String -> Stringify [Inline] -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
addField "citationSuffix" (Stringify [Inline] -> Lua ())
-> ([Inline] -> Stringify [Inline]) -> [Inline] -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify ([Inline] -> Lua ()) -> [Inline] -> Lua ()
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationSuffix Citation
cit
    String -> String -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
addField "citationMode" (String -> Lua ()) -> String -> Lua ()
forall a b. (a -> b) -> a -> b
$ CitationMode -> String
forall a. Show a => a -> String
show (Citation -> CitationMode
citationMode Citation
cit)
    String -> Int -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
addField "citationNoteNum" (Int -> Lua ()) -> Int -> Lua ()
forall a b. (a -> b) -> a -> b
$ Citation -> Int
citationNoteNum Citation
cit
    String -> Int -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
addField "citationHash" (Int -> Lua ()) -> Int -> Lua ()
forall a b. (a -> b) -> a -> b
$ 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 :: KeyValue a b -> Lua ()
push (KeyValue (k :: a
k, v :: b
v)) = do
    Lua ()
Lua.newtable
    a -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push a
k
    b -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push b
v
    StackIndex -> Lua ()
Lua.rawset (CInt -> StackIndex
Lua.nthFromTop 3)

data PandocLuaException = PandocLuaException Text
    deriving (Int -> PandocLuaException -> ShowS
[PandocLuaException] -> ShowS
PandocLuaException -> String
(Int -> PandocLuaException -> ShowS)
-> (PandocLuaException -> String)
-> ([PandocLuaException] -> ShowS)
-> Show PandocLuaException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PandocLuaException] -> ShowS
$cshowList :: [PandocLuaException] -> ShowS
show :: PandocLuaException -> String
$cshow :: PandocLuaException -> String
showsPrec :: Int -> PandocLuaException -> ShowS
$cshowsPrec :: Int -> PandocLuaException -> ShowS
Show, Typeable)

instance Exception PandocLuaException

-- | Convert Pandoc to custom markup.
writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text
writeCustom :: String -> WriterOptions -> Pandoc -> PandocIO Text
writeCustom luaFile :: String
luaFile opts :: WriterOptions
opts doc :: Pandoc
doc@(Pandoc meta :: Meta
meta _) = do
  let globals :: [Global]
globals = [ Pandoc -> Global
PANDOC_DOCUMENT Pandoc
doc
                , String -> Global
PANDOC_SCRIPT_FILE String
luaFile
                ]
  Either LuaException (Text, Context Text)
res <- Lua (Text, Context Text)
-> PandocIO (Either LuaException (Text, Context Text))
forall a. Lua a -> PandocIO (Either LuaException a)
runLua (Lua (Text, Context Text)
 -> PandocIO (Either LuaException (Text, Context Text)))
-> Lua (Text, Context Text)
-> PandocIO (Either LuaException (Text, Context Text))
forall a b. (a -> b) -> a -> b
$ do
    [Global] -> Lua ()
setGlobals [Global]
globals
    Status
stat <- String -> Lua Status
dofileWithTraceback String
luaFile
    -- check for error in lua script (later we'll change the return type
    -- to handle this more gracefully):
    Bool -> Lua () -> Lua ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
stat Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK) (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$
      StackIndex -> Lua ByteString
Lua.tostring' (-1) Lua ByteString -> (ByteString -> Lua ()) -> Lua ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PandocLuaException -> Lua ()
forall a e. Exception e => e -> a
throw (PandocLuaException -> Lua ())
-> (ByteString -> PandocLuaException) -> ByteString -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocLuaException
PandocLuaException (Text -> PandocLuaException)
-> (ByteString -> Text) -> ByteString -> PandocLuaException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
UTF8.toText
    String
rendered <- WriterOptions -> Pandoc -> Lua String
docToCustom WriterOptions
opts Pandoc
doc
    Context Text
context <- WriterOptions
-> ([Block] -> Lua (Doc Text))
-> ([Inline] -> Lua (Doc Text))
-> Meta
-> Lua (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
               ((String -> Doc Text) -> Lua String -> Lua (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (String -> Text) -> String -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (Lua String -> Lua (Doc Text))
-> ([Block] -> Lua String) -> [Block] -> Lua (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Lua String
blockListToCustom)
               ((String -> Doc Text) -> Lua String -> Lua (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (String -> Text) -> String -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (Lua String -> Lua (Doc Text))
-> ([Inline] -> Lua String) -> [Inline] -> Lua (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Lua String
inlineListToCustom)
               Meta
meta
    (Text, Context Text) -> Lua (Text, Context Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
pack String
rendered, Context Text
context)
  let (body :: Text
body, context :: Context Text
context) = case Either LuaException (Text, Context Text)
res of
        Left (LuaException msg :: Text
msg) -> PandocLuaException -> (Text, Context Text)
forall a e. Exception e => e -> a
throw (Text -> PandocLuaException
PandocLuaException Text
msg)
        Right x :: (Text, Context Text)
x -> (Text, Context Text)
x
  Text -> PandocIO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> PandocIO Text) -> Text -> PandocIO Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Nothing  -> Text
body
       Just tpl :: Template Text
tpl -> Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
                    Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl (Context Text -> Doc Text) -> Context Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
setField "body" Text
body Context Text
context

docToCustom :: WriterOptions -> Pandoc -> Lua String
docToCustom :: WriterOptions -> Pandoc -> Lua String
docToCustom opts :: WriterOptions
opts (Pandoc (Meta metamap :: Map Text MetaValue
metamap) blocks :: [Block]
blocks) = do
  String
body <- [Block] -> Lua String
blockListToCustom [Block]
blocks
  String
-> String
-> Map Text (Stringify MetaValue)
-> Context Text
-> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Doc" String
body ((MetaValue -> Stringify MetaValue)
-> Map Text MetaValue -> Map Text (Stringify MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaValue -> Stringify MetaValue
forall a. a -> Stringify a
Stringify Map Text MetaValue
metamap) (WriterOptions -> Context Text
writerVariables WriterOptions
opts)

-- | Convert Pandoc block element to Custom.
blockToCustom :: Block         -- ^ Block element
              -> Lua String

blockToCustom :: Block -> Lua String
blockToCustom Null = String -> Lua String
forall (m :: * -> *) a. Monad m => a -> m a
return ""

blockToCustom (Plain inlines :: [Inline]
inlines) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Plain" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
inlines)

blockToCustom (Para [Image attr :: Attr
attr txt :: [Inline]
txt (src :: Text
src,tit :: Text
tit)]) =
  String
-> Text
-> Text
-> Stringify [Inline]
-> Map Text Text
-> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "CaptionedImage" Text
src Text
tit ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
txt) (Attr -> Map Text Text
attrToMap Attr
attr)

blockToCustom (Para inlines :: [Inline]
inlines) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Para" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
inlines)

blockToCustom (LineBlock linesList :: [[Inline]]
linesList) =
  String -> [Stringify [Inline]] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "LineBlock" (([Inline] -> Stringify [Inline])
-> [[Inline]] -> [Stringify [Inline]]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [[Inline]]
linesList)

blockToCustom (RawBlock format :: Format
format str :: Text
str) =
  String -> Stringify Format -> Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "RawBlock" (Format -> Stringify Format
forall a. a -> Stringify a
Stringify Format
format) Text
str

blockToCustom HorizontalRule = String -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "HorizontalRule"

blockToCustom (Header level :: Int
level attr :: Attr
attr inlines :: [Inline]
inlines) =
  String -> Int -> Stringify [Inline] -> Map Text Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Header" Int
level ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
inlines) (Attr -> Map Text Text
attrToMap Attr
attr)

blockToCustom (CodeBlock attr :: Attr
attr str :: Text
str) =
  String -> Text -> Map Text Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "CodeBlock" Text
str (Attr -> Map Text Text
attrToMap Attr
attr)

blockToCustom (BlockQuote blocks :: [Block]
blocks) =
  String -> Stringify [Block] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "BlockQuote" ([Block] -> Stringify [Block]
forall a. a -> Stringify a
Stringify [Block]
blocks)

blockToCustom (Table capt :: [Inline]
capt aligns :: [Alignment]
aligns widths :: [Double]
widths headers :: [[Block]]
headers rows :: [[[Block]]]
rows) =
  let aligns' :: [String]
aligns' = (Alignment -> String) -> [Alignment] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Alignment -> String
forall a. Show a => a -> String
show [Alignment]
aligns
      capt' :: Stringify [Inline]
capt' = [Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
capt
      headers' :: [Stringify [Block]]
headers' = ([Block] -> Stringify [Block]) -> [[Block]] -> [Stringify [Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Stringify [Block]
forall a. a -> Stringify a
Stringify [[Block]]
headers
      rows' :: [[Stringify [Block]]]
rows' = ([[Block]] -> [Stringify [Block]])
-> [[[Block]]] -> [[Stringify [Block]]]
forall a b. (a -> b) -> [a] -> [b]
map (([Block] -> Stringify [Block]) -> [[Block]] -> [Stringify [Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Stringify [Block]
forall a. a -> Stringify a
Stringify) [[[Block]]]
rows
  in String
-> Stringify [Inline]
-> [String]
-> [Double]
-> [Stringify [Block]]
-> [[Stringify [Block]]]
-> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Table" Stringify [Inline]
capt' [String]
aligns' [Double]
widths [Stringify [Block]]
headers' [[Stringify [Block]]]
rows'

blockToCustom (BulletList items :: [[Block]]
items) =
  String -> [Stringify [Block]] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "BulletList" (([Block] -> Stringify [Block]) -> [[Block]] -> [Stringify [Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Stringify [Block]
forall a. a -> Stringify a
Stringify [[Block]]
items)

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

blockToCustom (DefinitionList items :: [([Inline], [[Block]])]
items) =
  String
-> [KeyValue (Stringify [Inline]) [Stringify [Block]]]
-> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "DefinitionList"
               ((([Inline], [[Block]])
 -> KeyValue (Stringify [Inline]) [Stringify [Block]])
-> [([Inline], [[Block]])]
-> [KeyValue (Stringify [Inline]) [Stringify [Block]]]
forall a b. (a -> b) -> [a] -> [b]
map ((Stringify [Inline], [Stringify [Block]])
-> KeyValue (Stringify [Inline]) [Stringify [Block]]
forall a b. (a, b) -> KeyValue a b
KeyValue ((Stringify [Inline], [Stringify [Block]])
 -> KeyValue (Stringify [Inline]) [Stringify [Block]])
-> (([Inline], [[Block]])
    -> (Stringify [Inline], [Stringify [Block]]))
-> ([Inline], [[Block]])
-> KeyValue (Stringify [Inline]) [Stringify [Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify ([Inline] -> Stringify [Inline])
-> ([[Block]] -> [Stringify [Block]])
-> ([Inline], [[Block]])
-> (Stringify [Inline], [Stringify [Block]])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ([Block] -> Stringify [Block]) -> [[Block]] -> [Stringify [Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Stringify [Block]
forall a. a -> Stringify a
Stringify)) [([Inline], [[Block]])]
items)

blockToCustom (Div attr :: Attr
attr items :: [Block]
items) =
  String -> Stringify [Block] -> Map Text Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Div" ([Block] -> Stringify [Block]
forall a. a -> Stringify a
Stringify [Block]
items) (Attr -> Map Text Text
attrToMap Attr
attr)

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

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

-- | Convert Pandoc inline element to Custom.
inlineToCustom :: Inline -> Lua String

inlineToCustom :: Inline -> Lua String
inlineToCustom (Str str :: Text
str) = String -> Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Str" Text
str

inlineToCustom Space = String -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Space"

inlineToCustom SoftBreak = String -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "SoftBreak"

inlineToCustom (Emph lst :: [Inline]
lst) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Emph" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Strong lst :: [Inline]
lst) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Strong" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Strikeout lst :: [Inline]
lst) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Strikeout" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Superscript lst :: [Inline]
lst) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Superscript" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Subscript lst :: [Inline]
lst) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Subscript" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (SmallCaps lst :: [Inline]
lst) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "SmallCaps" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Quoted SingleQuote lst :: [Inline]
lst) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "SingleQuoted" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Quoted DoubleQuote lst :: [Inline]
lst) = String -> Stringify [Inline] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "DoubleQuoted" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
lst)

inlineToCustom (Cite cs :: [Citation]
cs lst :: [Inline]
lst) = String -> Stringify [Inline] -> [Stringify Citation] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Cite" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
lst) ((Citation -> Stringify Citation)
-> [Citation] -> [Stringify Citation]
forall a b. (a -> b) -> [a] -> [b]
map Citation -> Stringify Citation
forall a. a -> Stringify a
Stringify [Citation]
cs)

inlineToCustom (Code attr :: Attr
attr str :: Text
str) =
  String -> Text -> Map Text Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Code" Text
str (Attr -> Map Text Text
attrToMap Attr
attr)

inlineToCustom (Math DisplayMath str :: Text
str) =
  String -> Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "DisplayMath" Text
str

inlineToCustom (Math InlineMath str :: Text
str) =
  String -> Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "InlineMath" Text
str

inlineToCustom (RawInline format :: Format
format str :: Text
str) =
  String -> Stringify Format -> Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "RawInline" (Format -> Stringify Format
forall a. a -> Stringify a
Stringify Format
format) Text
str

inlineToCustom LineBreak = String -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "LineBreak"

inlineToCustom (Link attr :: Attr
attr txt :: [Inline]
txt (src :: Text
src,tit :: Text
tit)) =
  String
-> Stringify [Inline]
-> Text
-> Text
-> Map Text Text
-> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Link" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
txt) Text
src Text
tit (Attr -> Map Text Text
attrToMap Attr
attr)

inlineToCustom (Image attr :: Attr
attr alt :: [Inline]
alt (src :: Text
src,tit :: Text
tit)) =
  String
-> Stringify [Inline]
-> Text
-> Text
-> Map Text Text
-> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Image" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
alt) Text
src Text
tit (Attr -> Map Text Text
attrToMap Attr
attr)

inlineToCustom (Note contents :: [Block]
contents) = String -> Stringify [Block] -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Note" ([Block] -> Stringify [Block]
forall a. a -> Stringify a
Stringify [Block]
contents)

inlineToCustom (Span attr :: Attr
attr items :: [Inline]
items) =
  String -> Stringify [Inline] -> Map Text Text -> Lua String
forall a. LuaCallFunc a => String -> a
Lua.callFunc "Span" ([Inline] -> Stringify [Inline]
forall a. a -> Stringify a
Stringify [Inline]
items) (Attr -> Map Text Text
attrToMap Attr
attr)