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.
This commit is contained in:
Albert Krewinkel
parent
ce73dec833
commit
0abb9bdc54
1 changed files with 52 additions and 64 deletions
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue