Lua modules: make a Haskell module for each Lua module
Definitions for the `pandoc.mediabag` modules are moved to a separate Haskell module. Change: minor
This commit is contained in:
parent
ab3c506584
commit
5ad719c1fb
4 changed files with 113 additions and 74 deletions
|
@ -523,6 +523,7 @@ library
|
||||||
Text.Pandoc.Readers.Org.Shared,
|
Text.Pandoc.Readers.Org.Shared,
|
||||||
Text.Pandoc.Lua.Filter,
|
Text.Pandoc.Lua.Filter,
|
||||||
Text.Pandoc.Lua.Init,
|
Text.Pandoc.Lua.Init,
|
||||||
|
Text.Pandoc.Lua.Module.MediaBag,
|
||||||
Text.Pandoc.Lua.Module.Pandoc,
|
Text.Pandoc.Lua.Module.Pandoc,
|
||||||
Text.Pandoc.Lua.Packages,
|
Text.Pandoc.Lua.Packages,
|
||||||
Text.Pandoc.Lua.StackInstances,
|
Text.Pandoc.Lua.StackInstances,
|
||||||
|
|
108
src/Text/Pandoc/Lua/Module/MediaBag.hs
Normal file
108
src/Text/Pandoc/Lua/Module/MediaBag.hs
Normal file
|
@ -0,0 +1,108 @@
|
||||||
|
{-
|
||||||
|
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.Module.MediaBag
|
||||||
|
Copyright : Copyright © 2017 Albert Krewinkel
|
||||||
|
License : GNU GPL, version 2 or above
|
||||||
|
|
||||||
|
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
|
||||||
|
Stability : alpha
|
||||||
|
|
||||||
|
The lua module @pandoc.mediabag@.
|
||||||
|
-}
|
||||||
|
module Text.Pandoc.Lua.Module.MediaBag
|
||||||
|
( pushModule
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (zipWithM_)
|
||||||
|
import Data.IORef (IORef, modifyIORef', readIORef)
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Foreign.Lua (Lua, NumResults, liftIO)
|
||||||
|
import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState,
|
||||||
|
runIOorExplode, setMediaBag)
|
||||||
|
import Text.Pandoc.Lua.StackInstances ()
|
||||||
|
import Text.Pandoc.Lua.Util (OrNil (toMaybe), addFunction)
|
||||||
|
import Text.Pandoc.MIME (MimeType)
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Lazy as BL
|
||||||
|
import qualified Foreign.Lua as Lua
|
||||||
|
import qualified Text.Pandoc.MediaBag as MB
|
||||||
|
|
||||||
|
--
|
||||||
|
-- MediaBag submodule
|
||||||
|
--
|
||||||
|
pushModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults
|
||||||
|
pushModule commonState mediaBagRef = do
|
||||||
|
Lua.newtable
|
||||||
|
addFunction "insert" (insertMediaFn mediaBagRef)
|
||||||
|
addFunction "lookup" (lookupMediaFn mediaBagRef)
|
||||||
|
addFunction "list" (mediaDirectoryFn mediaBagRef)
|
||||||
|
addFunction "fetch" (fetch commonState mediaBagRef)
|
||||||
|
return 1
|
||||||
|
|
||||||
|
insertMediaFn :: IORef MB.MediaBag
|
||||||
|
-> FilePath
|
||||||
|
-> OrNil MimeType
|
||||||
|
-> BL.ByteString
|
||||||
|
-> Lua NumResults
|
||||||
|
insertMediaFn mbRef fp nilOrMime contents = do
|
||||||
|
liftIO . modifyIORef' mbRef $
|
||||||
|
MB.insertMedia fp (toMaybe nilOrMime) contents
|
||||||
|
return 0
|
||||||
|
|
||||||
|
lookupMediaFn :: IORef MB.MediaBag
|
||||||
|
-> FilePath
|
||||||
|
-> Lua NumResults
|
||||||
|
lookupMediaFn mbRef fp = do
|
||||||
|
res <- MB.lookupMedia fp <$> liftIO (readIORef mbRef)
|
||||||
|
case res of
|
||||||
|
Nothing -> Lua.pushnil *> return 1
|
||||||
|
Just (mimeType, contents) -> do
|
||||||
|
Lua.push mimeType
|
||||||
|
Lua.push contents
|
||||||
|
return 2
|
||||||
|
|
||||||
|
mediaDirectoryFn :: IORef MB.MediaBag
|
||||||
|
-> Lua NumResults
|
||||||
|
mediaDirectoryFn mbRef = do
|
||||||
|
dirContents <- MB.mediaDirectory <$> liftIO (readIORef mbRef)
|
||||||
|
Lua.newtable
|
||||||
|
zipWithM_ addEntry [1..] dirContents
|
||||||
|
return 1
|
||||||
|
where
|
||||||
|
addEntry :: Int -> (FilePath, MimeType, Int) -> Lua ()
|
||||||
|
addEntry idx (fp, mimeType, contentLength) = do
|
||||||
|
Lua.newtable
|
||||||
|
Lua.push "path" *> Lua.push fp *> Lua.rawset (-3)
|
||||||
|
Lua.push "type" *> Lua.push mimeType *> Lua.rawset (-3)
|
||||||
|
Lua.push "length" *> Lua.push contentLength *> Lua.rawset (-3)
|
||||||
|
Lua.rawseti (-2) idx
|
||||||
|
|
||||||
|
fetch :: CommonState
|
||||||
|
-> IORef MB.MediaBag
|
||||||
|
-> String
|
||||||
|
-> Lua NumResults
|
||||||
|
fetch commonState mbRef src = do
|
||||||
|
mediaBag <- liftIO $ readIORef mbRef
|
||||||
|
(bs, mimeType) <- liftIO . runIOorExplode $ do
|
||||||
|
putCommonState commonState
|
||||||
|
setMediaBag mediaBag
|
||||||
|
fetchItem src
|
||||||
|
Lua.push $ fromMaybe "" mimeType
|
||||||
|
Lua.push bs
|
||||||
|
return 2 -- returns 2 values: contents, mimetype
|
|
@ -28,26 +28,22 @@ Pandoc module for lua.
|
||||||
-}
|
-}
|
||||||
module Text.Pandoc.Lua.Module.Pandoc
|
module Text.Pandoc.Lua.Module.Pandoc
|
||||||
( pushModule
|
( pushModule
|
||||||
, pushMediaBagModule
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (when, zipWithM_)
|
import Control.Monad (when)
|
||||||
import Data.Default (Default (..))
|
import Data.Default (Default (..))
|
||||||
import Data.Digest.Pure.SHA (sha1, showDigest)
|
import Data.Digest.Pure.SHA (sha1, showDigest)
|
||||||
import Data.IORef (IORef, modifyIORef', readIORef)
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Text (pack)
|
import Data.Text (pack)
|
||||||
import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO)
|
import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO)
|
||||||
import System.Exit (ExitCode (..))
|
import System.Exit (ExitCode (..))
|
||||||
import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState,
|
import Text.Pandoc.Class (runIO)
|
||||||
runIO, runIOorExplode, setMediaBag)
|
|
||||||
import Text.Pandoc.Definition (Block, Inline)
|
import Text.Pandoc.Definition (Block, Inline)
|
||||||
import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter)
|
import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter)
|
||||||
import Text.Pandoc.Lua.StackInstances ()
|
import Text.Pandoc.Lua.StackInstances ()
|
||||||
import Text.Pandoc.Lua.Util (OrNil (toMaybe), addFunction, addValue,
|
import Text.Pandoc.Lua.Util (OrNil (toMaybe), addFunction, addValue,
|
||||||
loadScriptFromDataDir, raiseError)
|
loadScriptFromDataDir, raiseError)
|
||||||
import Text.Pandoc.Walk (Walkable)
|
import Text.Pandoc.Walk (Walkable)
|
||||||
import Text.Pandoc.MIME (MimeType)
|
|
||||||
import Text.Pandoc.Options (ReaderOptions (readerExtensions))
|
import Text.Pandoc.Options (ReaderOptions (readerExtensions))
|
||||||
import Text.Pandoc.Process (pipeProcess)
|
import Text.Pandoc.Process (pipeProcess)
|
||||||
import Text.Pandoc.Readers (Reader (..), getReader)
|
import Text.Pandoc.Readers (Reader (..), getReader)
|
||||||
|
@ -55,7 +51,6 @@ import Text.Pandoc.Readers (Reader (..), getReader)
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.ByteString.Lazy.Char8 as BSL
|
import qualified Data.ByteString.Lazy.Char8 as BSL
|
||||||
import qualified Foreign.Lua as Lua
|
import qualified Foreign.Lua as Lua
|
||||||
import qualified Text.Pandoc.MediaBag as MB
|
|
||||||
|
|
||||||
-- | Push the "pandoc" on the lua stack. Requires the `list` module to be
|
-- | Push the "pandoc" on the lua stack. Requires the `list` module to be
|
||||||
-- loaded.
|
-- loaded.
|
||||||
|
@ -93,18 +88,6 @@ readDoc content formatSpecOrNil = do
|
||||||
Left s -> raiseError (show s) -- error while reading
|
Left s -> raiseError (show s) -- error while reading
|
||||||
_ -> raiseError "Only string formats are supported at the moment."
|
_ -> raiseError "Only string formats are supported at the moment."
|
||||||
|
|
||||||
--
|
|
||||||
-- MediaBag submodule
|
|
||||||
--
|
|
||||||
pushMediaBagModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults
|
|
||||||
pushMediaBagModule commonState mediaBagRef = do
|
|
||||||
Lua.newtable
|
|
||||||
addFunction "insert" (insertMediaFn mediaBagRef)
|
|
||||||
addFunction "lookup" (lookupMediaFn mediaBagRef)
|
|
||||||
addFunction "list" (mediaDirectoryFn mediaBagRef)
|
|
||||||
addFunction "fetch" (fetch commonState mediaBagRef)
|
|
||||||
return 1
|
|
||||||
|
|
||||||
sha1HashFn :: BL.ByteString
|
sha1HashFn :: BL.ByteString
|
||||||
-> Lua NumResults
|
-> Lua NumResults
|
||||||
sha1HashFn contents = do
|
sha1HashFn contents = do
|
||||||
|
@ -158,56 +141,3 @@ instance ToLuaStack PipeError where
|
||||||
, BSL.pack "): "
|
, BSL.pack "): "
|
||||||
, if output == mempty then BSL.pack "<no output>" else output
|
, if output == mempty then BSL.pack "<no output>" else output
|
||||||
]
|
]
|
||||||
-- end: pipe
|
|
||||||
|
|
||||||
insertMediaFn :: IORef MB.MediaBag
|
|
||||||
-> FilePath
|
|
||||||
-> OrNil MimeType
|
|
||||||
-> BL.ByteString
|
|
||||||
-> Lua NumResults
|
|
||||||
insertMediaFn mbRef fp nilOrMime contents = do
|
|
||||||
liftIO . modifyIORef' mbRef $
|
|
||||||
MB.insertMedia fp (toMaybe nilOrMime) contents
|
|
||||||
return 0
|
|
||||||
|
|
||||||
lookupMediaFn :: IORef MB.MediaBag
|
|
||||||
-> FilePath
|
|
||||||
-> Lua NumResults
|
|
||||||
lookupMediaFn mbRef fp = do
|
|
||||||
res <- MB.lookupMedia fp <$> liftIO (readIORef mbRef)
|
|
||||||
case res of
|
|
||||||
Nothing -> Lua.pushnil *> return 1
|
|
||||||
Just (mimeType, contents) -> do
|
|
||||||
Lua.push mimeType
|
|
||||||
Lua.push contents
|
|
||||||
return 2
|
|
||||||
|
|
||||||
mediaDirectoryFn :: IORef MB.MediaBag
|
|
||||||
-> Lua NumResults
|
|
||||||
mediaDirectoryFn mbRef = do
|
|
||||||
dirContents <- MB.mediaDirectory <$> liftIO (readIORef mbRef)
|
|
||||||
Lua.newtable
|
|
||||||
zipWithM_ addEntry [1..] dirContents
|
|
||||||
return 1
|
|
||||||
where
|
|
||||||
addEntry :: Int -> (FilePath, MimeType, Int) -> Lua ()
|
|
||||||
addEntry idx (fp, mimeType, contentLength) = do
|
|
||||||
Lua.newtable
|
|
||||||
Lua.push "path" *> Lua.push fp *> Lua.rawset (-3)
|
|
||||||
Lua.push "type" *> Lua.push mimeType *> Lua.rawset (-3)
|
|
||||||
Lua.push "length" *> Lua.push contentLength *> Lua.rawset (-3)
|
|
||||||
Lua.rawseti (-2) idx
|
|
||||||
|
|
||||||
fetch :: CommonState
|
|
||||||
-> IORef MB.MediaBag
|
|
||||||
-> String
|
|
||||||
-> Lua NumResults
|
|
||||||
fetch commonState mbRef src = do
|
|
||||||
mediaBag <- liftIO $ readIORef mbRef
|
|
||||||
(bs, mimeType) <- liftIO . runIOorExplode $ do
|
|
||||||
putCommonState commonState
|
|
||||||
setMediaBag mediaBag
|
|
||||||
fetchItem src
|
|
||||||
Lua.push $ fromMaybe "" mimeType
|
|
||||||
Lua.push bs
|
|
||||||
return 2 -- returns 2 values: contents, mimetype
|
|
||||||
|
|
|
@ -38,11 +38,11 @@ import Data.IORef (IORef)
|
||||||
import Foreign.Lua (Lua, NumResults, liftIO)
|
import Foreign.Lua (Lua, NumResults, liftIO)
|
||||||
import Text.Pandoc.Class (CommonState, readDataFile, runIO, setUserDataDir)
|
import Text.Pandoc.Class (CommonState, readDataFile, runIO, setUserDataDir)
|
||||||
import Text.Pandoc.MediaBag (MediaBag)
|
import Text.Pandoc.MediaBag (MediaBag)
|
||||||
import Text.Pandoc.Lua.Module.Pandoc (pushMediaBagModule)
|
|
||||||
import Text.Pandoc.Lua.Util (dostring')
|
import Text.Pandoc.Lua.Util (dostring')
|
||||||
|
|
||||||
import qualified Foreign.Lua as Lua
|
import qualified Foreign.Lua as Lua
|
||||||
import Text.Pandoc.Lua.Module.Pandoc as Pandoc
|
import Text.Pandoc.Lua.Module.Pandoc as Pandoc
|
||||||
|
import Text.Pandoc.Lua.Module.MediaBag as MediaBag
|
||||||
|
|
||||||
-- | Parameters used to create lua packages/modules.
|
-- | Parameters used to create lua packages/modules.
|
||||||
data LuaPackageParams = LuaPackageParams
|
data LuaPackageParams = LuaPackageParams
|
||||||
|
@ -76,7 +76,7 @@ pandocPackageSearcher luaPkgParams pkgName =
|
||||||
in pushWrappedHsFun (Pandoc.pushModule datadir)
|
in pushWrappedHsFun (Pandoc.pushModule datadir)
|
||||||
"pandoc.mediabag" -> let st = luaPkgCommonState luaPkgParams
|
"pandoc.mediabag" -> let st = luaPkgCommonState luaPkgParams
|
||||||
mbRef = luaPkgMediaBag luaPkgParams
|
mbRef = luaPkgMediaBag luaPkgParams
|
||||||
in pushWrappedHsFun (pushMediaBagModule st mbRef)
|
in pushWrappedHsFun (MediaBag.pushModule st mbRef)
|
||||||
_ -> searchPureLuaLoader
|
_ -> searchPureLuaLoader
|
||||||
where
|
where
|
||||||
pushWrappedHsFun f = do
|
pushWrappedHsFun f = do
|
||||||
|
|
Loading…
Add table
Reference in a new issue