Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Merge pull request #4153 from tarleb/unify-lua-init

Browse source 
Unify lua initalization
This commit is contained in:
John MacFarlane 2017-12-13 21:42:06 -07:00 committed by GitHub
commit 52a8116e71
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 179 additions and 144 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
pandoc.cabal
View file

@ -523,9 +523,10 @@ library
Text.Pandoc.Readers.Org.ParserState,
Text.Pandoc.Readers.Org.Parsing,
Text.Pandoc.Readers.Org.Shared,
Text.Pandoc.Lua.Filter,
Text.Pandoc.Lua.Init,
Text.Pandoc.Lua.Packages,
Text.Pandoc.Lua.PandocModule,
Text.Pandoc.Lua.Filter,
Text.Pandoc.Lua.StackInstances,
Text.Pandoc.Lua.Util,
Text.Pandoc.CSS,

4
src/Text/Pandoc/App.hs
View file

@ -223,7 +223,7 @@ convertWithOpts opts = do
if ".lua" `isSuffixOf` format
-- note: use non-lowercased version writerName
then return (TextWriter
(\o d -> liftIO $ writeCustom writerName o d)
(\o d -> writeCustom writerName o d)
:: Writer PandocIO, mempty)
else case getWriter writerName of
Left e -> E.throwIO $ PandocAppError $
@ -846,7 +846,7 @@ applyLuaFilters :: Maybe FilePath -> [FilePath] -> String -> Pandoc
applyLuaFilters mbDatadir filters format d = do
expandedFilters <- mapM (expandFilterPath mbDatadir) filters
let go f d' = do
res <- runLuaFilter mbDatadir f format d'
res <- runLuaFilter f format d'
case res of
Right x -> return x
Left (LuaException s) -> E.throw (PandocFilterError f s)

67
src/Text/Pandoc/Lua.hs
View file

@ -1,9 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-
Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
@ -29,48 +23,36 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
Pandoc lua utils.
Running pandoc Lua filters.
-}
module Text.Pandoc.Lua
( LuaException (..)
, LuaPackageParams (..)
, pushPandocModule
, runLuaFilter
, initLuaState
, luaPackageParams
, runPandocLua
, pushPandocModule
) where
import Control.Monad (when, (>=>))
import Control.Monad.Identity (Identity)
import Control.Monad.Trans (MonadIO (..))
import Data.IORef (newIORef, readIORef)
import Foreign.Lua (FromLuaStack (peek), Lua, LuaException (..),
Status (OK), ToLuaStack (push))
import Text.Pandoc.Class (PandocIO, getCommonState, getMediaBag, setMediaBag)
import Text.Pandoc.Definition
import Text.Pandoc.Class (PandocIO)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter)
import Text.Pandoc.Lua.Packages (LuaPackageParams (..),
installPandocPackageSearcher)
import Text.Pandoc.Lua.Init (runPandocLua)
import Text.Pandoc.Lua.PandocModule (pushPandocModule) -- TODO: remove
import Text.Pandoc.Lua.Util (loadScriptFromDataDir)
import qualified Foreign.Lua as Lua
import qualified Foreign.Lua.Module.Text as Lua
runLuaFilter :: Maybe FilePath -> FilePath -> String
-- | Run the Lua filter in @filterPath@ for a transformation to target
-- format @format@. Pandoc uses Lua init files to setup the Lua
-- interpreter.
runLuaFilter :: FilePath -> String
-> Pandoc -> PandocIO (Either LuaException Pandoc)
runLuaFilter datadir filterPath format pd = do
luaPkgParams <- luaPackageParams datadir
res <- liftIO . Lua.runLuaEither $
runLuaFilter' luaPkgParams filterPath format pd
newMediaBag <- liftIO (readIORef (luaPkgMediaBag luaPkgParams))
setMediaBag newMediaBag
return res
runLuaFilter filterPath format doc =
runPandocLua (runLuaFilter' filterPath format doc)
runLuaFilter' :: LuaPackageParams
-> FilePath -> String
runLuaFilter' :: FilePath -> String
-> Pandoc -> Lua Pandoc
runLuaFilter' luaPkgOpts filterPath format pd = do
initLuaState luaPkgOpts
runLuaFilter' filterPath format pd = do
-- store module in global "pandoc"
registerFormat
top <- Lua.gettop
@ -90,24 +72,6 @@ runLuaFilter' luaPkgOpts filterPath format pd = do
push format
Lua.setglobal "FORMAT"
luaPackageParams :: Maybe FilePath -> PandocIO LuaPackageParams
luaPackageParams datadir = do
commonState <- getCommonState
mbRef <- liftIO . newIORef =<< getMediaBag
return LuaPackageParams
{ luaPkgCommonState = commonState
, luaPkgDataDir = datadir
, luaPkgMediaBag = mbRef
}
-- Initialize the lua state with all required values
initLuaState :: LuaPackageParams -> Lua ()
initLuaState luaPkgParams = do
Lua.openlibs
Lua.preloadTextModule "text"
installPandocPackageSearcher luaPkgParams
loadScriptFromDataDir (luaPkgDataDir luaPkgParams) "init.lua"
pushGlobalFilter :: Lua ()
pushGlobalFilter = do
Lua.newtable
@ -117,6 +81,3 @@ pushGlobalFilter = do
runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc
runAll = foldr ((>=>) . walkMWithLuaFilter) return
instance (FromLuaStack a) => FromLuaStack (Identity a) where
peek = fmap return . peek

79
src/Text/Pandoc/Lua/Init.hs Normal file
View file

@ -0,0 +1,79 @@
{-
Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- |
Module : Text.Pandoc.Lua
Copyright : Copyright © 2017 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
Functions to initialize the Lua interpreter.
-}
module Text.Pandoc.Lua.Init
( LuaException (..)
, LuaPackageParams (..)
, runPandocLua
, initLuaState
, luaPackageParams
) where
import Control.Monad.Trans (MonadIO (..))
import Data.IORef (newIORef, readIORef)
import Foreign.Lua (Lua, LuaException (..))
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
import Text.Pandoc.Class (PandocIO, getCommonState, getUserDataDir, getMediaBag,
setMediaBag)
import Text.Pandoc.Lua.Packages (LuaPackageParams (..),
installPandocPackageSearcher)
import Text.Pandoc.Lua.Util (loadScriptFromDataDir)
import qualified Foreign.Lua as Lua
import qualified Foreign.Lua.Module.Text as Lua
-- | Run the lua interpreter, using pandoc's default way of environment
-- initalization.
runPandocLua :: Lua a -> PandocIO (Either LuaException a)
runPandocLua luaOp = do
datadir <- getUserDataDir
luaPkgParams <- luaPackageParams datadir
enc <- liftIO $ getForeignEncoding <* setForeignEncoding utf8
res <- liftIO $ Lua.runLuaEither (initLuaState luaPkgParams *> luaOp)
liftIO $ setForeignEncoding enc
newMediaBag <- liftIO (readIORef (luaPkgMediaBag luaPkgParams))
setMediaBag newMediaBag
return res
-- | Generate parameters required to setup pandoc's lua environment.
luaPackageParams :: Maybe FilePath -> PandocIO LuaPackageParams
luaPackageParams datadir = do
commonState <- getCommonState
mbRef <- liftIO . newIORef =<< getMediaBag
return LuaPackageParams
{ luaPkgCommonState = commonState
, luaPkgDataDir = datadir
, luaPkgMediaBag = mbRef
}
-- Initialize the lua state with all required values
initLuaState :: LuaPackageParams -> Lua ()
initLuaState luaPkgParams = do
Lua.openlibs
Lua.preloadTextModule "text"
installPandocPackageSearcher luaPkgParams
loadScriptFromDataDir (luaPkgDataDir luaPkgParams) "init.lua"

139
src/Text/Pandoc/Writers/Custom.hs
View file

@ -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,19 +30,23 @@ 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 Control.Monad.Trans (MonadIO (liftIO))
import Data.Char (toLower)
import Data.List (intersperse)
import qualified Data.Map as M
import Data.Text (Text, pack)
import Data.Typeable
import Foreign.Lua (Lua, ToLuaStack (..), callFunc, runLua)
import Foreign.Lua (Lua, ToLuaStack (..), callFunc)
import Foreign.Lua.Api
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
import Text.Pandoc.Class (PandocIO)
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Lua.Util (addValue)
import Text.Pandoc.Lua.Init (runPandocLua)
import Text.Pandoc.Lua.StackInstances ()
import Text.Pandoc.Lua.Util (addValue, dostring')
import Text.Pandoc.Options
import Text.Pandoc.Templates
import qualified Text.Pandoc.UTF8 as UTF8
@ -60,43 +58,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
@ -107,14 +93,11 @@ data PandocLuaException = PandocLuaException String
instance Exception PandocLuaException
-- | Convert Pandoc to custom markup.
writeCustom :: FilePath -> WriterOptions -> Pandoc -> IO Text
writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text
writeCustom luaFile opts doc@(Pandoc meta _) = do
luaScript <- UTF8.readFile luaFile
enc <- getForeignEncoding
setForeignEncoding utf8
(body, context) <- runLua $ do
openlibs
stat <- loadstring luaScript
luaScript <- liftIO $ UTF8.readFile luaFile
res <- runPandocLua $ do
stat <- dostring' luaScript
-- check for error in lua script (later we'll change the return type
-- to handle this more gracefully):
when (stat /= OK) $
@ -127,7 +110,9 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
inlineListToCustom
meta
return (rendered, context)
setForeignEncoding enc
let (body, context) = case res of
Left e -> throw (PandocLuaException (show e))
Right x -> x
case writerTemplate opts of
Nothing -> return $ pack body
Just tpl ->
@ -138,7 +123,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 +131,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 +194,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 +222,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)

31
test/Tests/Lua.hs
View file

@ -10,9 +10,9 @@ import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder (bulletList, divWith, doc, doubleQuoted, emph,
header, linebreak, para, plain, rawBlock,
singleQuoted, space, str, strong, (<>))
import Text.Pandoc.Class (runIOorExplode)
import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
import Text.Pandoc.Definition (Block, Inline, Meta, Pandoc)
import Text.Pandoc.Lua (initLuaState, runLuaFilter, luaPackageParams)
import Text.Pandoc.Lua (runLuaFilter, runPandocLua)
import qualified Foreign.Lua as Lua
@ -95,8 +95,9 @@ tests = map (localOption (QuickCheckTests 20))
assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
assertFilterConversion msg filterPath docIn docExpected = do
docEither <- runIOorExplode $
runLuaFilter (Just "../data") ("lua" </> filterPath) [] docIn
docEither <- runIOorExplode $ do
setUserDataDir (Just "../data")
runLuaFilter ("lua" </> filterPath) [] docIn
case docEither of
Left _ -> fail "lua filter failed"
Right docRes -> assertEqual msg docExpected docRes
@ -105,14 +106,18 @@ roundtripEqual :: (Eq a, Lua.FromLuaStack a, Lua.ToLuaStack a) => a -> IO Bool
roundtripEqual x = (x ==) <$> roundtripped
where
roundtripped :: (Lua.FromLuaStack a, Lua.ToLuaStack a) => IO a
roundtripped = Lua.runLua $ do
initLuaState =<< Lua.liftIO (runIOorExplode (luaPackageParams (Just "../data")))
oldSize <- Lua.gettop
Lua.push x
size <- Lua.gettop
when (size - oldSize /= 1) $
error ("not exactly one additional element on the stack: " ++ show size)
res <- Lua.peekEither (-1)
roundtripped = runIOorExplode $ do
setUserDataDir (Just "../data")
res <- runPandocLua $ do
oldSize <- Lua.gettop
Lua.push x
size <- Lua.gettop
when (size - oldSize /= 1) $
error ("not exactly one additional element on the stack: " ++ show size)
res <- Lua.peekEither (-1)
case res of
Left _ -> error "could not read from stack"
Right y -> return y
case res of
Left _ -> error "could not read from stack"
Left e -> error (show e)
Right y -> return y