@@ -1,11 +1,5 @@
1−{-# OPTIONS_GHC -fno-warn-orphans #-}
2−{-# LANGUAGE CPP #-}
31{-# LANGUAGE DeriveDataTypeable #-}
42{-# LANGUAGE FlexibleInstances #-}
5−#if MIN_VERSION_base(4,8,0)
6−#else
7−{-# LANGUAGE OverlappingInstances #-}
8−#endif
93{- Copyright (C) 2012-2017 John MacFarlane <jgm@berkeley.edu>
104
115This program is free software; you can redistribute it and/or modify
@@ -36,6 +30,7 @@ Conversion of 'Pandoc' documents to custom markup using
3630a lua writer.
3731-}
3832module Text.Pandoc.Writers.Custom ( writeCustom ) where
33+import Control.Arrow ((***))
3934import Control.Exception
4035import Control.Monad (when)
4136import Data.Char (toLower)
@@ -48,6 +43,7 @@ import Foreign.Lua.Api
4843import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
4944import Text.Pandoc.Definition
5045import Text.Pandoc.Error
46+import Text.Pandoc.Lua.StackInstances ()
5147import Text.Pandoc.Lua.Util (addValue)
5248import Text.Pandoc.Options
5349import Text.Pandoc.Templates
@@ -60,43 +56,31 @@ attrToMap (id',classes,keyvals) = M.fromList
6056 : ("class", unwords classes)
6157 : keyvals
6258
63−instance ToLuaStack Double where
64− push = push . (realToFrac :: Double -> LuaNumber)
65−
66−instance ToLuaStack Int where
67− push = push . (fromIntegral :: Int -> LuaInteger)
68−
69−instance ToLuaStack Format where
70− push (Format f) = push (map toLower f)
71−
72−#if MIN_VERSION_base(4,8,0)
73−instance {-# OVERLAPS #-} ToLuaStack [Inline] where
74−#else
75−instance ToLuaStack [Inline] where
76−#endif
77− push ils = push =<< inlineListToCustom ils
78−
79−#if MIN_VERSION_base(4,8,0)
80−instance {-# OVERLAPS #-} ToLuaStack [Block] where
81−#else
82−instance ToLuaStack [Block] where
83−#endif
84− push ils = push =<< blockListToCustom ils
85−
86−instance ToLuaStack MetaValue where
87− push (MetaMap m) = push m
88− push (MetaList xs) = push xs
89− push (MetaBool x) = push x
90− push (MetaString s) = push s
91− push (MetaInlines ils) = push ils
92− push (MetaBlocks bs) = push bs
93−
94−instance ToLuaStack Citation where
95− push cit = do
59+newtype Stringify a = Stringify a
60+
61+instance ToLuaStack (Stringify Format) where
62+ push (Stringify (Format f)) = push (map toLower f)
63+
64+instance ToLuaStack (Stringify [Inline]) where
65+ push (Stringify ils) = push =<< inlineListToCustom ils
66+
67+instance ToLuaStack (Stringify [Block]) where
68+ push (Stringify blks) = push =<< blockListToCustom blks
69+
70+instance ToLuaStack (Stringify MetaValue) where
71+ push (Stringify (MetaMap m)) = push (fmap Stringify m)
72+ push (Stringify (MetaList xs)) = push (map Stringify xs)
73+ push (Stringify (MetaBool x)) = push x
74+ push (Stringify (MetaString s)) = push s
75+ push (Stringify (MetaInlines ils)) = push (Stringify ils)
76+ push (Stringify (MetaBlocks bs)) = push (Stringify bs)
77+
78+instance ToLuaStack (Stringify Citation) where
79+ push (Stringify cit) = do
9680 createtable 6 0
9781 addValue "citationId" $ citationId cit
98− addValue "citationPrefix" $ citationPrefix cit
99− addValue "citationSuffix" $ citationSuffix cit
82+ addValue "citationPrefix" . Stringify $ citationPrefix cit
83+ addValue "citationSuffix" . Stringify $ citationSuffix cit
10084 addValue "citationMode" $ show (citationMode cit)
10185 addValue "citationNoteNum" $ citationNoteNum cit
10286 addValue "citationHash" $ citationHash cit
@@ -138,7 +122,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
138122docToCustom :: WriterOptions -> Pandoc -> Lua String
139123docToCustom opts (Pandoc (Meta metamap) blocks) = do
140124 body <- blockListToCustom blocks
141− callFunc "Doc" body metamap (writerVariables opts)
125+ callFunc "Doc" body (fmap Stringify metamap) (writerVariables opts)
142126
143127-- | Convert Pandoc block element to Custom.
144128blockToCustom :: Block -- ^ Block element
@@ -146,41 +130,45 @@ blockToCustom :: Block -- ^ Block element
146130
147131blockToCustom Null = return ""
148132
149−blockToCustom (Plain inlines) = callFunc "Plain" inlines
133+blockToCustom (Plain inlines) = callFunc "Plain" (Stringify inlines)
150134
151135blockToCustom (Para [Image attr txt (src,tit)]) =
152− callFunc "CaptionedImage" src tit txt (attrToMap attr)
136+ callFunc "CaptionedImage" src tit (Stringify txt) (attrToMap attr)
153137
154−blockToCustom (Para inlines) = callFunc "Para" inlines
138+blockToCustom (Para inlines) = callFunc "Para" (Stringify inlines)
155139
156−blockToCustom (LineBlock linesList) = callFunc "LineBlock" linesList
140+blockToCustom (LineBlock linesList) = callFunc "LineBlock" (map Stringify linesList)
157141
158142blockToCustom (RawBlock format str) =
159− callFunc "RawBlock" format str
143+ callFunc "RawBlock" (Stringify format) str
160144
161145blockToCustom HorizontalRule = callFunc "HorizontalRule"
162146
163147blockToCustom (Header level attr inlines) =
164− callFunc "Header" level inlines (attrToMap attr)
148+ callFunc "Header" level (Stringify inlines) (attrToMap attr)
165149
166150blockToCustom (CodeBlock attr str) =
167151 callFunc "CodeBlock" str (attrToMap attr)
168152
169−blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" blocks
153+blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" (Stringify blocks)
170154
171−blockToCustom (Table capt aligns widths headers rows') =
172− callFunc "Table" capt (map show aligns) widths headers rows'
155+blockToCustom (Table capt aligns widths headers rows) =
156+ let aligns' = map show aligns
157+ capt' = Stringify capt
158+ headers' = map Stringify headers
159+ rows' = map (map Stringify) rows
160+ in callFunc "Table" capt' aligns' widths headers' rows'
173161
174−blockToCustom (BulletList items) = callFunc "BulletList" items
162+blockToCustom (BulletList items) = callFunc "BulletList" (map Stringify items)
175163
176164blockToCustom (OrderedList (num,sty,delim) items) =
177− callFunc "OrderedList" items num (show sty) (show delim)
165+ callFunc "OrderedList" (map Stringify items) num (show sty) (show delim)
178166
179167blockToCustom (DefinitionList items) =
180− callFunc "DefinitionList" items
168+ callFunc "DefinitionList" (map (Stringify *** map Stringify) items)
181169
182170blockToCustom (Div attr items) =
183− callFunc "Div" items (attrToMap attr)
171+ callFunc "Div" (Stringify items) (attrToMap attr)
184172
185173-- | Convert list of Pandoc block elements to Custom.
186174blockListToCustom :: [Block] -- ^ List of block elements
@@ -205,23 +193,23 @@ inlineToCustom Space = callFunc "Space"
205193
206194inlineToCustom SoftBreak = callFunc "SoftBreak"
207195
208−inlineToCustom (Emph lst) = callFunc "Emph" lst
196+inlineToCustom (Emph lst) = callFunc "Emph" (Stringify lst)
209197
210−inlineToCustom (Strong lst) = callFunc "Strong" lst
198+inlineToCustom (Strong lst) = callFunc "Strong" (Stringify lst)
211199
212−inlineToCustom (Strikeout lst) = callFunc "Strikeout" lst
200+inlineToCustom (Strikeout lst) = callFunc "Strikeout" (Stringify lst)
213201
214−inlineToCustom (Superscript lst) = callFunc "Superscript" lst
202+inlineToCustom (Superscript lst) = callFunc "Superscript" (Stringify lst)
215203
216−inlineToCustom (Subscript lst) = callFunc "Subscript" lst
204+inlineToCustom (Subscript lst) = callFunc "Subscript" (Stringify lst)
217205
218−inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" lst
206+inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" (Stringify lst)
219207
220−inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" lst
208+inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" (Stringify lst)
221209
222−inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" lst
210+inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" (Stringify lst)
223211
224−inlineToCustom (Cite cs lst) = callFunc "Cite" lst cs
212+inlineToCustom (Cite cs lst) = callFunc "Cite" (Stringify lst) (map Stringify cs)
225213
226214inlineToCustom (Code attr str) =
227215 callFunc "Code" str (attrToMap attr)
@@ -233,17 +221,17 @@ inlineToCustom (Math InlineMath str) =
233221 callFunc "InlineMath" str
234222
235223inlineToCustom (RawInline format str) =
236− callFunc "RawInline" format str
224+ callFunc "RawInline" (Stringify format) str
237225
238226inlineToCustom LineBreak = callFunc "LineBreak"
239227
240228inlineToCustom (Link attr txt (src,tit)) =
241− callFunc "Link" txt src tit (attrToMap attr)
229+ callFunc "Link" (Stringify txt) src tit (attrToMap attr)
242230
243231inlineToCustom (Image attr alt (src,tit)) =
244− callFunc "Image" alt src tit (attrToMap attr)
232+ callFunc "Image" (Stringify alt) src tit (attrToMap attr)
245233
246−inlineToCustom (Note contents) = callFunc "Note" contents
234+inlineToCustom (Note contents) = callFunc "Note" (Stringify contents)
247235
248236inlineToCustom (Span attr items) =
249− callFunc "Span" items (attrToMap attr)
237+ callFunc "Span" (Stringify items) (attrToMap attr)