Custom writer: define instances for newtype wrapper

The custom writer used its own `ToLuaStack` instance definitions, which
made it difficult to share code with Lua filters, as this could result
in conflicting instances. A `Stringify` wrapper is introduced to avoid
this problem.

1 files changed, 57 insertions, 69 deletions

diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 87b97dcee..ffe637966 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -1,11 +1,5 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE CPP                  #-}
 {-# LANGUAGE DeriveDataTypeable   #-}
 {-# LANGUAGE FlexibleInstances    #-}
-#if MIN_VERSION_base(4,8,0)
-#else
-{-# LANGUAGE OverlappingInstances #-}
-#endif
 {- Copyright (C) 2012-2017 John MacFarlane <jgm@berkeley.edu>
 
 This program is free software; you can redistribute it and/or modify
@@ -36,6 +30,7 @@ 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.Char (toLower)
@@ -48,6 +43,7 @@ import Foreign.Lua.Api
 import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
 import Text.Pandoc.Definition
 import Text.Pandoc.Error
+import Text.Pandoc.Lua.StackInstances ()
 import Text.Pandoc.Lua.Util (addValue)
 import Text.Pandoc.Options
 import Text.Pandoc.Templates
@@ -60,43 +56,31 @@ attrToMap (id',classes,keyvals) = M.fromList
     : ("class", unwords classes)
     : keyvals
 
-instance ToLuaStack Double where
-  push = push . (realToFrac :: Double -> LuaNumber)
-
-instance ToLuaStack Int where
-  push = push . (fromIntegral :: Int -> LuaInteger)
-
-instance ToLuaStack Format where
-  push (Format f) = push (map toLower f)
-
-#if MIN_VERSION_base(4,8,0)
-instance {-# OVERLAPS #-} ToLuaStack [Inline] where
-#else
-instance ToLuaStack [Inline] where
-#endif
-  push ils = push =<< inlineListToCustom ils
-
-#if MIN_VERSION_base(4,8,0)
-instance {-# OVERLAPS #-} ToLuaStack [Block] where
-#else
-instance ToLuaStack [Block] where
-#endif
-  push ils = push =<< blockListToCustom ils
-
-instance ToLuaStack MetaValue where
-  push (MetaMap m)       = push m
-  push (MetaList xs)     = push xs
-  push (MetaBool x)      = push x
-  push (MetaString s)    = push s
-  push (MetaInlines ils) = push ils
-  push (MetaBlocks bs)   = push bs
-
-instance ToLuaStack Citation where
-  push cit = do
+newtype Stringify a = Stringify a
+
+instance ToLuaStack (Stringify Format) where
+  push (Stringify (Format f)) = push (map toLower f)
+
+instance ToLuaStack (Stringify [Inline]) where
+  push (Stringify ils) = push =<< inlineListToCustom ils
+
+instance ToLuaStack (Stringify [Block]) where
+  push (Stringify blks) = push =<< blockListToCustom blks
+
+instance ToLuaStack (Stringify MetaValue) where
+  push (Stringify (MetaMap m))       = push (fmap Stringify m)
+  push (Stringify (MetaList xs))     = push (map Stringify xs)
+  push (Stringify (MetaBool x))      = push x
+  push (Stringify (MetaString s))    = push s
+  push (Stringify (MetaInlines ils)) = push (Stringify ils)
+  push (Stringify (MetaBlocks bs))   = push (Stringify bs)
+
+instance ToLuaStack (Stringify Citation) where
+  push (Stringify cit) = do
     createtable 6 0
     addValue "citationId" $ citationId cit
-    addValue "citationPrefix" $ citationPrefix cit
-    addValue "citationSuffix" $ citationSuffix cit
+    addValue "citationPrefix" . Stringify $ citationPrefix cit
+    addValue "citationSuffix" . Stringify $ citationSuffix cit
     addValue "citationMode" $ show (citationMode cit)
     addValue "citationNoteNum" $ citationNoteNum cit
     addValue "citationHash" $ citationHash cit
@@ -138,7 +122,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
 docToCustom :: WriterOptions -> Pandoc -> Lua String
 docToCustom opts (Pandoc (Meta metamap) blocks) = do
   body <- blockListToCustom blocks
-  callFunc "Doc" body metamap (writerVariables opts)
+  callFunc "Doc" body (fmap Stringify metamap) (writerVariables opts)
 
 -- | Convert Pandoc block element to Custom.
 blockToCustom :: Block         -- ^ Block element
@@ -146,41 +130,45 @@ blockToCustom :: Block         -- ^ Block element
 
 blockToCustom Null = return ""
 
-blockToCustom (Plain inlines) = callFunc "Plain" inlines
+blockToCustom (Plain inlines) = callFunc "Plain" (Stringify inlines)
 
 blockToCustom (Para [Image attr txt (src,tit)]) =
-  callFunc "CaptionedImage" src tit txt (attrToMap attr)
+  callFunc "CaptionedImage" src tit (Stringify txt) (attrToMap attr)
 
-blockToCustom (Para inlines) = callFunc "Para" inlines
+blockToCustom (Para inlines) = callFunc "Para" (Stringify inlines)
 
-blockToCustom (LineBlock linesList) = callFunc "LineBlock" linesList
+blockToCustom (LineBlock linesList) = callFunc "LineBlock" (map Stringify linesList)
 
 blockToCustom (RawBlock format str) =
-  callFunc "RawBlock" format str
+  callFunc "RawBlock" (Stringify format) str
 
 blockToCustom HorizontalRule = callFunc "HorizontalRule"
 
 blockToCustom (Header level attr inlines) =
-  callFunc "Header" level inlines (attrToMap attr)
+  callFunc "Header" level (Stringify inlines) (attrToMap attr)
 
 blockToCustom (CodeBlock attr str) =
   callFunc "CodeBlock" str (attrToMap attr)
 
-blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" blocks
+blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" (Stringify blocks)
 
-blockToCustom (Table capt aligns widths headers rows') =
-  callFunc "Table" capt (map show aligns) widths headers rows'
+blockToCustom (Table capt aligns widths headers rows) =
+  let aligns' = map show aligns
+      capt' = Stringify capt
+      headers' = map Stringify headers
+      rows' = map (map Stringify) rows
+  in callFunc "Table" capt' aligns' widths headers' rows'
 
-blockToCustom (BulletList items) = callFunc "BulletList" items
+blockToCustom (BulletList items) = callFunc "BulletList" (map Stringify items)
 
 blockToCustom (OrderedList (num,sty,delim) items) =
-  callFunc "OrderedList" items num (show sty) (show delim)
+  callFunc "OrderedList" (map Stringify items) num (show sty) (show delim)
 
 blockToCustom (DefinitionList items) =
-  callFunc "DefinitionList" items
+  callFunc "DefinitionList" (map (Stringify *** map Stringify) items)
 
 blockToCustom (Div attr items) =
-  callFunc "Div" items (attrToMap attr)
+  callFunc "Div" (Stringify items) (attrToMap attr)
 
 -- | Convert list of Pandoc block elements to Custom.
 blockListToCustom :: [Block]       -- ^ List of block elements
@@ -205,23 +193,23 @@ inlineToCustom Space = callFunc "Space"
 
 inlineToCustom SoftBreak = callFunc "SoftBreak"
 
-inlineToCustom (Emph lst) = callFunc "Emph" lst
+inlineToCustom (Emph lst) = callFunc "Emph" (Stringify lst)
 
-inlineToCustom (Strong lst) = callFunc "Strong" lst
+inlineToCustom (Strong lst) = callFunc "Strong" (Stringify lst)
 
-inlineToCustom (Strikeout lst) = callFunc "Strikeout" lst
+inlineToCustom (Strikeout lst) = callFunc "Strikeout" (Stringify lst)
 
-inlineToCustom (Superscript lst) = callFunc "Superscript" lst
+inlineToCustom (Superscript lst) = callFunc "Superscript" (Stringify lst)
 
-inlineToCustom (Subscript lst) = callFunc "Subscript" lst
+inlineToCustom (Subscript lst) = callFunc "Subscript" (Stringify lst)
 
-inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" lst
+inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" (Stringify lst)
 
-inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" lst
+inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" (Stringify lst)
 
-inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" lst
+inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" (Stringify lst)
 
-inlineToCustom (Cite cs lst) = callFunc "Cite" lst cs
+inlineToCustom (Cite cs lst) = callFunc "Cite" (Stringify lst) (map Stringify cs)
 
 inlineToCustom (Code attr str) =
   callFunc "Code" str (attrToMap attr)
@@ -233,17 +221,17 @@ inlineToCustom (Math InlineMath str) =
   callFunc "InlineMath" str
 
 inlineToCustom (RawInline format str) =
-  callFunc "RawInline" format str
+  callFunc "RawInline" (Stringify format) str
 
 inlineToCustom LineBreak = callFunc "LineBreak"
 
 inlineToCustom (Link attr txt (src,tit)) =
-  callFunc "Link" txt src tit (attrToMap attr)
+  callFunc "Link" (Stringify txt) src tit (attrToMap attr)
 
 inlineToCustom (Image attr alt (src,tit)) =
-  callFunc "Image" alt src tit (attrToMap attr)
+  callFunc "Image" (Stringify alt) src tit (attrToMap attr)
 
-inlineToCustom (Note contents) = callFunc "Note" contents
+inlineToCustom (Note contents) = callFunc "Note" (Stringify contents)
 
 inlineToCustom (Span attr items) =
-  callFunc "Span" items (attrToMap attr)
+  callFunc "Span" (Stringify items) (attrToMap attr)