1{-# LANGUAGE FlexibleInstances  #-}
2{-# LANGUAGE OverloadedStrings  #-}
3{- |
4   Module      : Text.Pandoc.Writers.Custom
5   Copyright   : Copyright (C) 2012-2021 John MacFarlane
6   License     : GNU GPL, version 2 or above
7
8   Maintainer  : John MacFarlane <jgm@berkeley.edu>
9   Stability   : alpha
10   Portability : portable
11
12Conversion of 'Pandoc' documents to custom markup using
13a lua writer.
14-}
15module Text.Pandoc.Writers.Custom ( writeCustom ) where
16import Control.Arrow ((***))
17import Control.Exception
18import Control.Monad (when)
19import Data.List (intersperse)
20import qualified Data.Map as M
21import qualified Data.Text as T
22import Data.Text (Text, pack)
23import Foreign.Lua (Lua, Pushable)
24import Text.DocLayout (render, literal)
25import Text.Pandoc.Class.PandocIO (PandocIO)
26import Text.Pandoc.Definition
27import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
28import Text.Pandoc.Lua.Util (addField, dofileWithTraceback)
29import Text.Pandoc.Options
30import Text.Pandoc.Templates (renderTemplate)
31import Text.Pandoc.Writers.Shared
32
33import qualified Foreign.Lua as Lua
34
35attrToMap :: Attr -> M.Map T.Text T.Text
36attrToMap (id',classes,keyvals) = M.fromList
37    $ ("id", id')
38    : ("class", T.unwords classes)
39    : keyvals
40
41newtype Stringify a = Stringify a
42
43instance Pushable (Stringify Format) where
44  push (Stringify (Format f)) = Lua.push (T.toLower f)
45
46instance Pushable (Stringify [Inline]) where
47  push (Stringify ils) = Lua.push =<< inlineListToCustom ils
48
49instance Pushable (Stringify [Block]) where
50  push (Stringify blks) = Lua.push =<< blockListToCustom blks
51
52instance Pushable (Stringify MetaValue) where
53  push (Stringify (MetaMap m))       = Lua.push (fmap Stringify m)
54  push (Stringify (MetaList xs))     = Lua.push (map Stringify xs)
55  push (Stringify (MetaBool x))      = Lua.push x
56  push (Stringify (MetaString s))    = Lua.push s
57  push (Stringify (MetaInlines ils)) = Lua.push (Stringify ils)
58  push (Stringify (MetaBlocks bs))   = Lua.push (Stringify bs)
59
60instance Pushable (Stringify Citation) where
61  push (Stringify cit) = do
62    Lua.createtable 6 0
63    addField "citationId" $ citationId cit
64    addField "citationPrefix" . Stringify $ citationPrefix cit
65    addField "citationSuffix" . Stringify $ citationSuffix cit
66    addField "citationMode" $ show (citationMode cit)
67    addField "citationNoteNum" $ citationNoteNum cit
68    addField "citationHash" $ citationHash cit
69
70-- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the
71-- associated value.
72newtype KeyValue a b = KeyValue (a, b)
73
74instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where
75  push (KeyValue (k, v)) = do
76    Lua.newtable
77    Lua.push k
78    Lua.push v
79    Lua.rawset (Lua.nthFromTop 3)
80
81-- | Convert Pandoc to custom markup.
82writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text
83writeCustom luaFile opts doc@(Pandoc meta _) = do
84  let globals = [ PANDOC_DOCUMENT doc
85                , PANDOC_SCRIPT_FILE luaFile
86                ]
87  res <- runLua $ do
88    setGlobals globals
89    stat <- dofileWithTraceback luaFile
90    -- check for error in lua script (later we'll change the return type
91    -- to handle this more gracefully):
92    when (stat /= Lua.OK)
93      Lua.throwTopMessage
94    rendered <- docToCustom opts doc
95    context <- metaToContext opts
96               (fmap (literal . pack) . blockListToCustom)
97               (fmap (literal . pack) . inlineListToCustom)
98               meta
99    return (pack rendered, context)
100  case res of
101    Left msg -> throw msg
102    Right (body, context) -> return $
103      case writerTemplate opts of
104        Nothing  -> body
105        Just tpl -> render Nothing $
106                    renderTemplate tpl $ setField "body" body context
107
108docToCustom :: WriterOptions -> Pandoc -> Lua String
109docToCustom opts (Pandoc (Meta metamap) blocks) = do
110  body <- blockListToCustom blocks
111  Lua.callFunc "Doc" body (fmap Stringify metamap) (writerVariables opts)
112
113-- | Convert Pandoc block element to Custom.
114blockToCustom :: Block         -- ^ Block element
115              -> Lua String
116
117blockToCustom Null = return ""
118
119blockToCustom (Plain inlines) = Lua.callFunc "Plain" (Stringify inlines)
120
121blockToCustom (Para [Image attr txt (src,tit)]) =
122  Lua.callFunc "CaptionedImage" src tit (Stringify txt) (attrToMap attr)
123
124blockToCustom (Para inlines) = Lua.callFunc "Para" (Stringify inlines)
125
126blockToCustom (LineBlock linesList) =
127  Lua.callFunc "LineBlock" (map Stringify linesList)
128
129blockToCustom (RawBlock format str) =
130  Lua.callFunc "RawBlock" (Stringify format) str
131
132blockToCustom HorizontalRule = Lua.callFunc "HorizontalRule"
133
134blockToCustom (Header level attr inlines) =
135  Lua.callFunc "Header" level (Stringify inlines) (attrToMap attr)
136
137blockToCustom (CodeBlock attr str) =
138  Lua.callFunc "CodeBlock" str (attrToMap attr)
139
140blockToCustom (BlockQuote blocks) =
141  Lua.callFunc "BlockQuote" (Stringify blocks)
142
143blockToCustom (Table _ blkCapt specs thead tbody tfoot) =
144  let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
145      aligns' = map show aligns
146      capt' = Stringify capt
147      headers' = map Stringify headers
148      rows' = map (map Stringify) rows
149  in Lua.callFunc "Table" capt' aligns' widths headers' rows'
150
151blockToCustom (BulletList items) =
152  Lua.callFunc "BulletList" (map Stringify items)
153
154blockToCustom (OrderedList (num,sty,delim) items) =
155  Lua.callFunc "OrderedList" (map Stringify items) num (show sty) (show delim)
156
157blockToCustom (DefinitionList items) =
158  Lua.callFunc "DefinitionList"
159               (map (KeyValue . (Stringify *** map Stringify)) items)
160
161blockToCustom (Div attr items) =
162  Lua.callFunc "Div" (Stringify items) (attrToMap attr)
163
164-- | Convert list of Pandoc block elements to Custom.
165blockListToCustom :: [Block]       -- ^ List of block elements
166                  -> Lua String
167blockListToCustom xs = do
168  blocksep <- Lua.callFunc "Blocksep"
169  bs <- mapM blockToCustom xs
170  return $ mconcat $ intersperse blocksep bs
171
172-- | Convert list of Pandoc inline elements to Custom.
173inlineListToCustom :: [Inline] -> Lua String
174inlineListToCustom lst = do
175  xs <- mapM inlineToCustom lst
176  return $ mconcat xs
177
178-- | Convert Pandoc inline element to Custom.
179inlineToCustom :: Inline -> Lua String
180
181inlineToCustom (Str str) = Lua.callFunc "Str" str
182
183inlineToCustom Space = Lua.callFunc "Space"
184
185inlineToCustom SoftBreak = Lua.callFunc "SoftBreak"
186
187inlineToCustom (Emph lst) = Lua.callFunc "Emph" (Stringify lst)
188
189inlineToCustom (Underline lst) = Lua.callFunc "Underline" (Stringify lst)
190
191inlineToCustom (Strong lst) = Lua.callFunc "Strong" (Stringify lst)
192
193inlineToCustom (Strikeout lst) = Lua.callFunc "Strikeout" (Stringify lst)
194
195inlineToCustom (Superscript lst) = Lua.callFunc "Superscript" (Stringify lst)
196
197inlineToCustom (Subscript lst) = Lua.callFunc "Subscript" (Stringify lst)
198
199inlineToCustom (SmallCaps lst) = Lua.callFunc "SmallCaps" (Stringify lst)
200
201inlineToCustom (Quoted SingleQuote lst) = Lua.callFunc "SingleQuoted" (Stringify lst)
202
203inlineToCustom (Quoted DoubleQuote lst) = Lua.callFunc "DoubleQuoted" (Stringify lst)
204
205inlineToCustom (Cite cs lst) = Lua.callFunc "Cite" (Stringify lst) (map Stringify cs)
206
207inlineToCustom (Code attr str) =
208  Lua.callFunc "Code" str (attrToMap attr)
209
210inlineToCustom (Math DisplayMath str) =
211  Lua.callFunc "DisplayMath" str
212
213inlineToCustom (Math InlineMath str) =
214  Lua.callFunc "InlineMath" str
215
216inlineToCustom (RawInline format str) =
217  Lua.callFunc "RawInline" (Stringify format) str
218
219inlineToCustom LineBreak = Lua.callFunc "LineBreak"
220
221inlineToCustom (Link attr txt (src,tit)) =
222  Lua.callFunc "Link" (Stringify txt) src tit (attrToMap attr)
223
224inlineToCustom (Image attr alt (src,tit)) =
225  Lua.callFunc "Image" (Stringify alt) src tit (attrToMap attr)
226
227inlineToCustom (Note contents) = Lua.callFunc "Note" (Stringify contents)
228
229inlineToCustom (Span attr items) =
230  Lua.callFunc "Span" (Stringify items) (attrToMap attr)
231