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