From 0abb9bdc546d8a675bdfae95f0c402b79db19df5 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Tue, 12 Dec 2017 07:35:41 +0100
Subject: [PATCH] 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.
---
src/Text/Pandoc/Writers/Custom.hs | 116 ++++++++++++++----------------
1 file changed, 52 insertions(+), 64 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)
+newtype Stringify a = Stringify a
-instance ToLuaStack Int where
- push = push . (fromIntegral :: Int -> LuaInteger)
+instance ToLuaStack (Stringify Format) where
+ push (Stringify (Format f)) = push (map toLower f)
-instance ToLuaStack Format where
- push (Format f) = push (map toLower f)
+instance ToLuaStack (Stringify [Inline]) where
+ push (Stringify ils) = push =<< inlineListToCustom ils
-#if MIN_VERSION_base(4,8,0)
-instance {-# OVERLAPS #-} ToLuaStack [Inline] where
-#else
-instance ToLuaStack [Inline] where
-#endif
- push ils = push =<< inlineListToCustom ils
+instance ToLuaStack (Stringify [Block]) where
+ push (Stringify blks) = push =<< blockListToCustom blks
-#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 (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 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
+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)