From a0ec3e85ad046951154f2cc00691e326917e6bf2 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Sun, 26 Apr 2015 08:44:57 +0300 Subject: Custom Writer: Set foreign encoding to UTF-8 Closes #2101, #1634 Also factored out ByteString, since it's only used as an intermediate representation. --- src/Text/Pandoc/Writers/Custom.hs | 62 ++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 33 deletions(-) diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 3774fdde9..2f572f116 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -39,21 +39,19 @@ import Data.Typeable import Scripting.Lua (LuaState, StackValue, callfunc) import Text.Pandoc.Writers.Shared import qualified Scripting.Lua as Lua -import Text.Pandoc.UTF8 (fromString, toString) import qualified Text.Pandoc.UTF8 as UTF8 -import Data.ByteString (ByteString) -import qualified Data.ByteString as B import Data.Monoid import Control.Monad (when) import Control.Exception import qualified Data.Map as M import Text.Pandoc.Templates +import GHC.IO.Encoding (getForeignEncoding,setForeignEncoding, utf8) -attrToMap :: Attr -> M.Map ByteString ByteString +attrToMap :: Attr -> M.Map String String attrToMap (id',classes,keyvals) = M.fromList - $ ("id", fromString id') - : ("class", fromString $ unwords classes) - : map (\(x,y) -> (fromString x, fromString y)) keyvals + $ ("id", id') + : ("class", unwords classes) + : keyvals getList :: StackValue a => LuaState -> Int -> IO [a] getList lua i' = do @@ -67,11 +65,6 @@ getList lua i' = do return (x : rest) else return [] -instance StackValue ByteString where - push l x = Lua.push l $ toString x - peek l n = (fmap . fmap) fromString (Lua.peek l n) - valuetype _ = Lua.TSTRING - instance StackValue a => StackValue [a] where push lua xs = do Lua.createtable lua (length xs + 1) 0 @@ -111,12 +104,12 @@ instance (StackValue a, StackValue b) => StackValue (a,b) where valuetype _ = Lua.TTABLE instance StackValue [Inline] where - push l ils = Lua.push l . toString =<< inlineListToCustom l ils + push l ils = Lua.push l =<< inlineListToCustom l ils peek _ _ = undefined valuetype _ = Lua.TSTRING instance StackValue [Block] where - push l ils = Lua.push l . toString =<< blockListToCustom l ils + push l ils = Lua.push l =<< blockListToCustom l ils peek _ _ = undefined valuetype _ = Lua.TSTRING @@ -138,7 +131,7 @@ instance StackValue MetaValue where instance StackValue Citation where push lua cit = do Lua.createtable lua 6 0 - let addValue ((k :: String), v) = Lua.push lua k >> Lua.push lua v >> + let addValue (k :: String, v) = Lua.push lua k >> Lua.push lua v >> Lua.rawset lua (-3) addValue ("citationId", citationId cit) addValue ("citationPrefix", citationPrefix cit) @@ -158,6 +151,8 @@ instance Exception PandocLuaException writeCustom :: FilePath -> WriterOptions -> Pandoc -> IO String writeCustom luaFile opts doc@(Pandoc meta _) = do luaScript <- UTF8.readFile luaFile + enc <- getForeignEncoding + setForeignEncoding utf8 lua <- Lua.newstate Lua.openlibs lua status <- Lua.loadstring lua luaScript luaFile @@ -169,18 +164,19 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do -- TODO - call hierarchicalize, so we have that info rendered <- docToCustom lua opts doc context <- metaToJSON opts - (fmap toString . blockListToCustom lua) - (fmap toString . inlineListToCustom lua) + (blockListToCustom lua) + (inlineListToCustom lua) meta Lua.close lua - let body = toString rendered + setForeignEncoding enc + let body = rendered if writerStandalone opts then do let context' = setField "body" body context return $ renderTemplate' (writerTemplate opts) context' else return body -docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO ByteString +docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO String docToCustom lua opts (Pandoc (Meta metamap) blocks) = do body <- blockListToCustom lua blocks callfunc lua "Doc" body metamap (writerVariables opts) @@ -188,7 +184,7 @@ docToCustom lua opts (Pandoc (Meta metamap) blocks) = do -- | Convert Pandoc block element to Custom. blockToCustom :: LuaState -- ^ Lua state -> Block -- ^ Block element - -> IO ByteString + -> IO String blockToCustom _ Null = return "" @@ -200,7 +196,7 @@ blockToCustom lua (Para [Image txt (src,tit)]) = blockToCustom lua (Para inlines) = callfunc lua "Para" inlines blockToCustom lua (RawBlock format str) = - callfunc lua "RawBlock" format (fromString str) + callfunc lua "RawBlock" format str blockToCustom lua HorizontalRule = callfunc lua "HorizontalRule" @@ -208,7 +204,7 @@ blockToCustom lua (Header level attr inlines) = callfunc lua "Header" level inlines (attrToMap attr) blockToCustom lua (CodeBlock attr str) = - callfunc lua "CodeBlock" (fromString str) (attrToMap attr) + callfunc lua "CodeBlock" str (attrToMap attr) blockToCustom lua (BlockQuote blocks) = callfunc lua "BlockQuote" blocks @@ -229,22 +225,22 @@ blockToCustom lua (Div attr items) = -- | Convert list of Pandoc block elements to Custom. blockListToCustom :: LuaState -- ^ Options -> [Block] -- ^ List of block elements - -> IO ByteString + -> IO String blockListToCustom lua xs = do blocksep <- callfunc lua "Blocksep" bs <- mapM (blockToCustom lua) xs return $ mconcat $ intersperse blocksep bs -- | Convert list of Pandoc inline elements to Custom. -inlineListToCustom :: LuaState -> [Inline] -> IO ByteString +inlineListToCustom :: LuaState -> [Inline] -> IO String inlineListToCustom lua lst = do xs <- mapM (inlineToCustom lua) lst - return $ B.concat xs + return $ concat xs -- | Convert Pandoc inline element to Custom. -inlineToCustom :: LuaState -> Inline -> IO ByteString +inlineToCustom :: LuaState -> Inline -> IO String -inlineToCustom lua (Str str) = callfunc lua "Str" $ fromString str +inlineToCustom lua (Str str) = callfunc lua "Str" str inlineToCustom lua Space = callfunc lua "Space" @@ -267,24 +263,24 @@ inlineToCustom lua (Quoted DoubleQuote lst) = callfunc lua "DoubleQuoted" lst inlineToCustom lua (Cite cs lst) = callfunc lua "Cite" lst cs inlineToCustom lua (Code attr str) = - callfunc lua "Code" (fromString str) (attrToMap attr) + callfunc lua "Code" str (attrToMap attr) inlineToCustom lua (Math DisplayMath str) = - callfunc lua "DisplayMath" (fromString str) + callfunc lua "DisplayMath" str inlineToCustom lua (Math InlineMath str) = - callfunc lua "InlineMath" (fromString str) + callfunc lua "InlineMath" str inlineToCustom lua (RawInline format str) = - callfunc lua "RawInline" format (fromString str) + callfunc lua "RawInline" format str inlineToCustom lua (LineBreak) = callfunc lua "LineBreak" inlineToCustom lua (Link txt (src,tit)) = - callfunc lua "Link" txt (fromString src) (fromString tit) + callfunc lua "Link" txt src tit inlineToCustom lua (Image alt (src,tit)) = - callfunc lua "Image" alt (fromString src) (fromString tit) + callfunc lua "Image" alt src tit inlineToCustom lua (Note contents) = callfunc lua "Note" contents -- cgit v1.2.3