Merge pull request #3550 from tarleb/lua-readers-submodule

Lua module: add readers submodule

3 files changed, 150 insertions, 30 deletions

diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index 6fa6b2020..d754b43b8 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -15,11 +15,7 @@ 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
 -}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 {- |
    Module      : Text.Pandoc.Lua
    Copyright   : Copyright © 2017 Albert Krewinkel
@@ -34,24 +30,23 @@ module Text.Pandoc.Lua ( runLuaFilter ) where
 
 import Control.Monad ( (>=>), when )
 import Control.Monad.Trans ( MonadIO(..) )
-import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
 import Data.HashMap.Lazy ( HashMap )
 import Data.Text ( Text, pack, unpack )
 import Data.Text.Encoding ( decodeUtf8 )
 import Scripting.Lua ( LuaState, StackValue(..) )
-import Scripting.Lua.Aeson ()
+import Scripting.Lua.Aeson ( newstate )
 import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
 import Text.Pandoc.Lua.PandocModule
+import Text.Pandoc.Lua.StackInstances ()
 import Text.Pandoc.Walk
 
 import qualified Data.HashMap.Lazy as HashMap
 import qualified Scripting.Lua as Lua
-import qualified Scripting.Lua as LuaAeson
 
 runLuaFilter :: (MonadIO m)
              => FilePath -> [String] -> Pandoc -> m Pandoc
 runLuaFilter filterPath args pd = liftIO $ do
-  lua <- LuaAeson.newstate
+  lua <- newstate
   Lua.openlibs lua
   Lua.newtable lua
   Lua.setglobal lua "PANDOC_FILTER_FUNCTIONS"  -- hack, store functions here
@@ -204,23 +199,3 @@ isLuaFunction lua fnName = do
   res <- Lua.isfunction lua (-1)
   Lua.pop lua (-1)
   return res
-
-maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a
-maybeFromJson mv = fromJSON <$> mv >>= \case
-  Success x -> Just x
-  _         -> Nothing
-
-instance StackValue Pandoc where
-  push lua = Lua.push lua . toJSON
-  peek lua i = maybeFromJson <$> peek lua i
-  valuetype _ = Lua.TTABLE
-
-instance StackValue Block where
-  push lua = Lua.push lua . toJSON
-  peek lua i = maybeFromJson <$> peek lua i
-  valuetype _ = Lua.TTABLE
-
-instance StackValue Inline where
-  push lua = Lua.push lua . toJSON
-  peek lua i = maybeFromJson <$> peek lua i
-  valuetype _ = Lua.TTABLE
diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/PandocModule.hs
index 87d1fa6b9..d0c78f562 100644
--- a/src/Text/Pandoc/Lua/PandocModule.hs
+++ b/src/Text/Pandoc/Lua/PandocModule.hs
@@ -28,11 +28,25 @@ Pandoc module for lua.
 module Text.Pandoc.Lua.PandocModule ( pushPandocModule ) where
 
 import Data.ByteString.Char8 ( unpack )
-import Scripting.Lua ( LuaState, call)
+import Data.Default ( Default(..) )
+import Scripting.Lua ( LuaState, call, newtable, push, pushhsfunction, rawset)
+import Text.Pandoc.Class hiding ( readDataFile )
+import Text.Pandoc.Definition ( Pandoc(..), Block(..) )
 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.Shared ( readDataFile )
 
-
 -- | Push the "pandoc" on the lua stack.
 pushPandocModule :: LuaState -> IO ()
 pushPandocModule lua = do
@@ -42,7 +56,63 @@ pushPandocModule lua = do
     then return ()
     else do
       call lua 0 1
+  push lua "reader"
+  pushReadersModule lua readers
+  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)
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
new file mode 100644
index 000000000..0c9addc23
--- /dev/null
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -0,0 +1,75 @@
+{-
+Copyright © 2012-2015 John MacFarlane <jgm@berkeley.edu>
+            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
+-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+#if !MIN_VERSION_base(4,8,0)
+{-# LANGUAGE OverlappingInstances #-}
+#endif
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{- |
+   Module      : Text.Pandoc.Lua.StackInstances
+   Copyright   : Copyright © 2017 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   Stability   : alpha
+
+StackValue instances for pandoc types.
+-}
+module Text.Pandoc.Lua.StackInstances () where
+
+import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
+import Scripting.Lua ( StackValue(..) )
+import Scripting.Lua.Aeson ()
+import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
+
+import qualified Scripting.Lua as Lua
+import qualified Text.Pandoc.UTF8 as UTF8
+
+maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a
+maybeFromJson mv = fromJSON <$> mv >>= \case
+  Success x -> Just x
+  _         -> Nothing
+
+instance StackValue Pandoc where
+  push lua = Lua.push lua . toJSON
+  peek lua i = maybeFromJson <$> peek lua i
+  valuetype _ = Lua.TTABLE
+
+instance StackValue Block where
+  push lua = Lua.push lua . toJSON
+  peek lua i = maybeFromJson <$> peek lua i
+  valuetype _ = Lua.TTABLE
+
+instance StackValue Inline where
+  push lua = Lua.push lua . toJSON
+  peek lua i = maybeFromJson <$> peek lua i
+  valuetype _ = Lua.TTABLE
+
+#if MIN_VERSION_base(4,8,0)
+instance {-# OVERLAPS #-} StackValue [Char] where
+#else
+instance StackValue [Char] where
+#endif
+  push lua cs = Lua.push lua (UTF8.fromString cs)
+  peek lua i = do
+                 res <- Lua.peek lua i
+                 return $ UTF8.toString `fmap` res
+  valuetype _ = Lua.TSTRING