Lua module: provide simple `read` format parser

A single `read` function parsing pandoc-supported formats is added to
the module. This is simpler and more convenient than the previous method
of exposing all reader functions individually.

2 files changed, 28 insertions, 67 deletions

diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/PandocModule.hs
index d0c78f562..15f19f024 100644
--- a/src/Text/Pandoc/Lua/PandocModule.hs
+++ b/src/Text/Pandoc/Lua/PandocModule.hs
@@ -29,22 +29,12 @@ module Text.Pandoc.Lua.PandocModule ( pushPandocModule ) where
 
 import Data.ByteString.Char8 ( unpack )
 import Data.Default ( Default(..) )
-import Scripting.Lua ( LuaState, call, newtable, push, pushhsfunction, rawset)
+import Scripting.Lua ( LuaState, call, push, pushhsfunction, rawset)
 import Text.Pandoc.Class hiding ( readDataFile )
-import Text.Pandoc.Definition ( Pandoc(..), Block(..) )
+import Text.Pandoc.Definition ( Pandoc )
 import Text.Pandoc.Lua.Compat ( loadstring )
 import Text.Pandoc.Lua.StackInstances ()
-import Text.Pandoc.Readers.DocBook ( readDocBook )
-import Text.Pandoc.Readers.HTML ( readHtml )
-import Text.Pandoc.Readers.LaTeX ( readLaTeX )
-import Text.Pandoc.Readers.Native ( readNative )
-import Text.Pandoc.Readers.Markdown ( readMarkdown )
-import Text.Pandoc.Readers.MediaWiki ( readMediaWiki )
-import Text.Pandoc.Readers.Org ( readOrg )
-import Text.Pandoc.Readers.RST ( readRST )
-import Text.Pandoc.Readers.Textile ( readTextile )
-import Text.Pandoc.Readers.TWiki ( readTWiki )
-import Text.Pandoc.Readers.Txt2Tags ( readTxt2Tags )
+import Text.Pandoc.Readers ( Reader(..), getReader )
 import Text.Pandoc.Shared ( readDataFile )
 
 -- | Push the "pandoc" on the lua stack.
@@ -56,63 +46,24 @@ pushPandocModule lua = do
     then return ()
     else do
       call lua 0 1
-  push lua "reader"
-  pushReadersModule lua readers
+  push lua "__read"
+  pushhsfunction lua read_doc
   rawset lua (-3)
 
-readers :: [(String, String -> PandocIO Pandoc)]
-readers =
-  [ ("docbook", readDocBook def)
-  , ("html", readHtml def)
-  , ("latex", readLaTeX def)
-  , ("native", readNative def)
-  , ("markdown", readMarkdown def)
-  , ("mediawiki", readMediaWiki def)
-  , ("org", readOrg def)
-  , ("rst", readRST def)
-  , ("textile", readTextile def)
-  , ("twiki", readTWiki def)
-  , ("txt2tags", readTxt2Tags def)
-  ]
-
 -- | Get the string representation of the pandoc module
 pandocModuleScript :: IO String
 pandocModuleScript = unpack <$> readDataFile Nothing "pandoc.lua"
 
--- | Push a lua table containing readers of the given formats.
-pushReadersModule :: LuaState
-                 -> [(String, String -> PandocIO Pandoc)]
-                 -> IO ()
-pushReadersModule lua readerFns = do
-  newtable lua
-  mapM_ (uncurry $ addReaderTable) readerFns
- where
-   addReaderTable :: String
-                  -> (String -> PandocIO Pandoc)
-                  -> IO ()
-   addReaderTable formatName readerFn = do
-     let readDoc :: String -> IO Pandoc
-         readDoc s = do
-           res <- runIO $ readerFn s
-           case res of
-             (Left x) -> error (show x)
-             (Right x) -> return x
-     let readBlock :: String -> IO Block
-         readBlock s = do
-           Pandoc _ blks <- readDoc s
-           return $ case blks of
-             x:_ -> x
-             _   -> Null
-     -- Push table containing all functions for this format
-     push lua formatName
-     newtable lua
-     -- set document-reading function
-     push lua "read_doc"
-     pushhsfunction lua readDoc
-     rawset lua (-3)
-     -- set block-reading function
-     push lua "read_block"
-     pushhsfunction lua readBlock
-     rawset lua (-3)
-     -- store table in readers module
-     rawset lua (-3)
+read_doc :: String -> String -> IO (Either String Pandoc)
+read_doc formatSpec content = do
+  case getReader formatSpec of
+    Left s -> return $ Left s
+    Right reader ->
+      case reader of
+        StringReader r -> do
+          res <- runIO $ r def content
+          case res of
+            Left s -> return . Left $ show s
+            Right pd -> return $ Right pd
+        _  -> return $ Left "Only string formats are supported at the moment."
+
diff --git a/src/Text/Pandoc/Lua/SharedInstances.hs b/src/Text/Pandoc/Lua/SharedInstances.hs
index 02438b93b..3d2d29ebf 100644
--- a/src/Text/Pandoc/Lua/SharedInstances.hs
+++ b/src/Text/Pandoc/Lua/SharedInstances.hs
@@ -104,3 +104,13 @@ instance (Ord a, StackValue a, StackValue b) =>
     mapM_ (uncurry $ addValue lua) $ M.toList m
   peek lua idx = fmap M.fromList <$> keyValuePairs lua idx
   valuetype _ = TTABLE
+
+instance (StackValue a, StackValue b) => StackValue (Either a b) where
+  push lua = \case
+    Left x -> push lua x
+    Right x -> push lua x
+  peek lua idx = peek lua idx >>= \case
+      Just left -> return . Just $ Left left
+      Nothing   -> fmap Right <$> peek lua idx
+  valuetype (Left x) = valuetype x
+  valuetype (Right x) = valuetype x