aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJohn MacFarlane <[email protected]>2022-09-12 17:57:47 +0200
committerJohn MacFarlane <[email protected]>2022-09-20 14:11:13 -0700
commit7c07e57b6037fe1d1d941df70f53d974d4726796 (patch)
tree564c8b48bed5deb3a43f32edeee422f216f29a6a /src/Text
parent5e377cc9c096c912f10cc477afecc7957488814b (diff)
Add T.P.Lua.Reader, T.P.Lua.Writer.
(Unexported modules, presently.) These contain the definitions of `readCustom` and `writeCustom` that were previously in T.P.Readers.Custom and T.P.Writers.Custom. Motivation is to ensure that all of the Lua-related code is under the T.P.Lua tree. This will make it easier to make pandoc-lua a separate package or put lua support under a flag, if we decide to do that.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Lua/Reader.hs84
-rw-r--r--src/Text/Pandoc/Lua/Writer.hs64
-rw-r--r--src/Text/Pandoc/Readers/Custom.hs72
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs45
4 files changed, 150 insertions, 115 deletions
diff --git a/src/Text/Pandoc/Lua/Reader.hs b/src/Text/Pandoc/Lua/Reader.hs
new file mode 100644
index 000000000..6303dace3
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Reader.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+ Module : Text.Pandoc.Lua.Reader
+ Copyright : Copyright (C) 2021-2022 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <[email protected]>
+ Stability : alpha
+ Portability : portable
+
+Supports custom parsers written in Lua which produce a Pandoc AST.
+-}
+module Text.Pandoc.Lua.Reader ( readCustom ) where
+import Control.Exception
+import Control.Monad (when)
+import Control.Monad.IO.Class (MonadIO)
+import Data.Maybe (fromMaybe)
+import HsLua as Lua hiding (Operation (Div))
+import Text.Pandoc.Definition
+import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback, report)
+import Text.Pandoc.Logging
+import Text.Pandoc.Lua.Global (Global (..), setGlobals)
+import Text.Pandoc.Lua.Init (runLua)
+import Text.Pandoc.Lua.PandocLua
+import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc)
+import Text.Pandoc.Options
+import Text.Pandoc.Sources (ToSources(..), sourcesToText)
+import qualified Data.Text as T
+
+-- | Convert custom markup to Pandoc.
+readCustom :: (PandocMonad m, MonadIO m, ToSources s)
+ => FilePath -> ReaderOptions -> s -> m Pandoc
+readCustom luaFile opts srcs = do
+ let globals = [ PANDOC_SCRIPT_FILE luaFile ]
+ luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "readers" luaFile
+ res <- runLua $ do
+ setGlobals globals
+ stat <- dofileTrace luaFile'
+ -- check for error in lua script (later we'll change the return type
+ -- to handle this more gracefully):
+ when (stat /= Lua.OK)
+ Lua.throwErrorAsException
+ parseCustom
+ case res of
+ Left msg -> throw msg
+ Right doc -> return doc
+ where
+ parseCustom = do
+ let input = toSources srcs
+ getglobal "Reader"
+ push input
+ push opts
+ pcallTrace 2 1 >>= \case
+ OK -> forcePeek $ peekPandoc top
+ ErrRun -> do
+ -- Caught a runtime error. Check if parsing might work if we
+ -- pass a string instead of a Sources list, then retry.
+ runPeek (peekText top) >>= \case
+ Failure {} ->
+ -- not a string error object. Bail!
+ throwErrorAsException
+ Success errmsg -> do
+ if "string expected, got pandoc Sources" `T.isInfixOf` errmsg
+ then do
+ pop 1
+ _ <- unPandocLua $ do
+ report $ Deprecated "old Reader function signature" $
+ T.unlines
+ [ "Reader functions should accept a sources list; "
+ , "functions expecting `string` input are deprecated. "
+ , "Use `tostring` to convert the first argument to a "
+ , "string."
+ ]
+ getglobal "Reader"
+ push $ sourcesToText input -- push sources as string
+ push opts
+ callTrace 2 1
+ forcePeek $ peekPandoc top
+ else
+ -- nothing we can do here
+ throwErrorAsException
+ _ -> -- not a runtime error, we won't be able to recover from that
+ throwErrorAsException
diff --git a/src/Text/Pandoc/Lua/Writer.hs b/src/Text/Pandoc/Lua/Writer.hs
new file mode 100644
index 000000000..6b4273d88
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Writer.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+ Module : Text.Pandoc.Lua.Writer
+ Copyright : Copyright (C) 2012-2022 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <[email protected]>
+ Stability : alpha
+ Portability : portable
+
+Conversion of Pandoc documents using a custom Lua writer.
+-}
+module Text.Pandoc.Lua.Writer
+ ( writeCustom
+ ) where
+
+import Control.Exception
+import Control.Monad ((<=<))
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import HsLua
+import Control.Monad.IO.Class (MonadIO)
+import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback)
+import Text.Pandoc.Definition (Pandoc (..))
+import Text.Pandoc.Lua.Global (Global (..), setGlobals)
+import Text.Pandoc.Lua.Init (runLua)
+import Text.Pandoc.Options (WriterOptions)
+import qualified Text.Pandoc.Lua.Writer.Classic as Classic
+
+-- | Convert Pandoc to custom markup.
+writeCustom :: (PandocMonad m, MonadIO m)
+ => FilePath -> WriterOptions -> Pandoc -> m Text
+writeCustom luaFile opts doc = do
+ luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "writers" luaFile
+ either throw pure <=< runLua $ do
+ setGlobals [ PANDOC_DOCUMENT doc
+ , PANDOC_SCRIPT_FILE luaFile'
+ , PANDOC_WRITER_OPTIONS opts
+ ]
+ dofileTrace luaFile' >>= \case
+ OK -> pure ()
+ _ -> throwErrorAsException
+ -- Most classic writers contain code that throws an error if a global
+ -- is not present. This would break our check for the existence of a
+ -- "Writer" function. We resort to raw access for that reason, but
+ -- could also catch the error instead.
+ let rawgetglobal x = do
+ pushglobaltable
+ pushName x
+ rawget (nth 2) <* remove (nth 2) -- remove global table
+
+ rawgetglobal "Writer" >>= \case
+ TypeNil -> do
+ pop 1 -- remove nil
+ Classic.runCustom opts doc
+ _ -> do
+ -- Writer on top of the stack. Call it with document and writer
+ -- options as arguments.
+ push doc
+ push opts
+ callTrace 2 1
+ forcePeek $ peekText top
+
diff --git a/src/Text/Pandoc/Readers/Custom.hs b/src/Text/Pandoc/Readers/Custom.hs
index 37959574e..9935d1ee6 100644
--- a/src/Text/Pandoc/Readers/Custom.hs
+++ b/src/Text/Pandoc/Readers/Custom.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Readers.Custom
Copyright : Copyright (C) 2021-2022 John MacFarlane
@@ -12,72 +10,4 @@
Supports custom parsers written in Lua which produce a Pandoc AST.
-}
module Text.Pandoc.Readers.Custom ( readCustom ) where
-import Control.Exception
-import Control.Monad (when)
-import Control.Monad.IO.Class (MonadIO)
-import Data.Maybe (fromMaybe)
-import HsLua as Lua hiding (Operation (Div))
-import Text.Pandoc.Definition
-import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback, report)
-import Text.Pandoc.Logging
-import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
-import Text.Pandoc.Lua.PandocLua
-import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc)
-import Text.Pandoc.Options
-import Text.Pandoc.Sources (ToSources(..), sourcesToText)
-import qualified Data.Text as T
-
--- | Convert custom markup to Pandoc.
-readCustom :: (PandocMonad m, MonadIO m, ToSources s)
- => FilePath -> ReaderOptions -> s -> m Pandoc
-readCustom luaFile opts srcs = do
- let globals = [ PANDOC_SCRIPT_FILE luaFile ]
- luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "readers" luaFile
- res <- runLua $ do
- setGlobals globals
- stat <- dofileTrace luaFile'
- -- check for error in lua script (later we'll change the return type
- -- to handle this more gracefully):
- when (stat /= Lua.OK)
- Lua.throwErrorAsException
- parseCustom
- case res of
- Left msg -> throw msg
- Right doc -> return doc
- where
- parseCustom = do
- let input = toSources srcs
- getglobal "Reader"
- push input
- push opts
- pcallTrace 2 1 >>= \case
- OK -> forcePeek $ peekPandoc top
- ErrRun -> do
- -- Caught a runtime error. Check if parsing might work if we
- -- pass a string instead of a Sources list, then retry.
- runPeek (peekText top) >>= \case
- Failure {} ->
- -- not a string error object. Bail!
- throwErrorAsException
- Success errmsg -> do
- if "string expected, got pandoc Sources" `T.isInfixOf` errmsg
- then do
- pop 1
- _ <- unPandocLua $ do
- report $ Deprecated "old Reader function signature" $
- T.unlines
- [ "Reader functions should accept a sources list; "
- , "functions expecting `string` input are deprecated. "
- , "Use `tostring` to convert the first argument to a "
- , "string."
- ]
- getglobal "Reader"
- push $ sourcesToText input -- push sources as string
- push opts
- callTrace 2 1
- forcePeek $ peekPandoc top
- else
- -- nothing we can do here
- throwErrorAsException
- _ -> -- not a runtime error, we won't be able to recover from that
- throwErrorAsException
+import Text.Pandoc.Lua.Reader ( readCustom )
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index b7c99a155..ae0cf0c7e 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -10,49 +10,6 @@ Conversion of 'Pandoc' documents to custom markup using
a Lua writer.
-}
module Text.Pandoc.Writers.Custom ( writeCustom ) where
-import Control.Exception
-import Control.Monad ((<=<))
-import Data.Maybe (fromMaybe)
-import Data.Text (Text)
-import HsLua
-import Control.Monad.IO.Class (MonadIO)
-import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback)
-import Text.Pandoc.Definition (Pandoc (..))
-import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
-import Text.Pandoc.Options (WriterOptions)
-import qualified Text.Pandoc.Lua.Writer.Classic as Classic
+import Text.Pandoc.Lua.Writer ( writeCustom )
--- | Convert Pandoc to custom markup.
-writeCustom :: (PandocMonad m, MonadIO m)
- => FilePath -> WriterOptions -> Pandoc -> m Text
-writeCustom luaFile opts doc = do
- luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "writers" luaFile
- either throw pure <=< runLua $ do
- setGlobals [ PANDOC_DOCUMENT doc
- , PANDOC_SCRIPT_FILE luaFile'
- , PANDOC_WRITER_OPTIONS opts
- ]
- dofileTrace luaFile' >>= \case
- OK -> pure ()
- _ -> throwErrorAsException
- -- Most classic writers contain code that throws an error if a global
- -- is not present. This would break our check for the existence of a
- -- "Writer" function. We resort to raw access for that reason, but
- -- could also catch the error instead.
- let rawgetglobal x = do
- pushglobaltable
- pushName x
- rawget (nth 2) <* remove (nth 2) -- remove global table
-
- rawgetglobal "Writer" >>= \case
- TypeNil -> do
- pop 1 -- remove nil
- Classic.runCustom opts doc
- _ -> do
- -- Writer on top of the stack. Call it with document and writer
- -- options as arguments.
- push doc
- push opts
- callTrace 2 1
- forcePeek $ peekText top