{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Module.MediaBag
( documentedModule
) where
import Prelude hiding (lookup)
import Data.Maybe (fromMaybe)
import HsLua ( LuaE, DocumentedFunction, Module (..)
, (<#>), (###), (=#>), (=?>), (#?), defun, functionResult
, opt, parameter, stringParam, textParam)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad (fetchItem, fillMediaBag, getMediaBag,
modifyCommonState, setMediaBag)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc, pushPandoc)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Lua.Orphans ()
import Text.Pandoc.Lua.PandocLua (unPandocLua)
import Text.Pandoc.MIME (MimeType)
import qualified Data.ByteString.Lazy as BL
import qualified HsLua as Lua
import qualified Text.Pandoc.MediaBag as MB
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module
{ moduleName :: Name
moduleName = Name
"pandoc.mediabag"
, moduleDescription :: Text
moduleDescription = Text
"mediabag access"
, moduleFields :: [Field PandocError]
moduleFields = []
, moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions =
[ DocumentedFunction PandocError
delete
, DocumentedFunction PandocError
empty
, DocumentedFunction PandocError
fetch
, DocumentedFunction PandocError
fill
, DocumentedFunction PandocError
insert
, DocumentedFunction PandocError
items
, DocumentedFunction PandocError
list
, DocumentedFunction PandocError
lookup
]
, moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
}
delete :: DocumentedFunction PandocError
delete :: DocumentedFunction PandocError
delete = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"delete"
### (\fp -> unPandocLua $ modifyCommonState
(\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) }))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e FilePath
stringParam Text
"filepath" Text
"filename of item to delete"
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
empty :: DocumentedFunction PandocError
empty :: DocumentedFunction PandocError
empty = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"empty"
### unPandocLua (modifyCommonState (\st -> st { stMediaBag = mempty }))
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
fill :: DocumentedFunction PandocError
fill :: DocumentedFunction PandocError
fill = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"fill"
### unPandocLua . fillMediaBag
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"doc"
Text
"document from which to fill the mediabag"
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc Text
"Pandoc" Text
"modified document"
#? ("Fills the mediabag with the images in the given document.\n" <>
"An image that cannot be retrieved will be replaced with a Span\n" <>
"of class \"image\" that contains the image description.\n" <>
"" <>
"Images for which the mediabag already contains an item will\n" <>
"not be processed again.")
insert :: DocumentedFunction PandocError
insert :: DocumentedFunction PandocError
insert = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"insert"
### (\fp mmime contents -> unPandocLua $ do
mb <- getMediaBag
setMediaBag $ MB.insertMedia fp mmime contents mb
return (Lua.NumResults 0))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e FilePath
stringParam Text
"filepath" Text
"item file path"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Text
textParam Text
"mimetype" Text
"the item's MIME type")
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e ByteString
Lua.peekLazyByteString Text
"string" Text
"contents" Text
"binary contents"
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
items :: DocumentedFunction PandocError
items :: DocumentedFunction PandocError
items = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"items"
### (do
mb <-unPandocLua getMediaBag
let pushItem (fp, mimetype, contents) = do
Lua.pushString fp
Lua.pushText mimetype
Lua.pushByteString $ BL.toStrict contents
return (Lua.NumResults 3)
Lua.pushIterator pushItem (MB.mediaItems mb))
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"Iterator triple"
lookup :: DocumentedFunction PandocError
lookup :: DocumentedFunction PandocError
lookup = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"lookup"
### (\fp -> unPandocLua (MB.lookupMedia fp <$> getMediaBag) >>= \case
Nothing -> 1 <$ Lua.pushnil
Just item -> 2 <$ do
Lua.pushText $ MB.mediaMimeType item
Lua.pushLazyByteString $ MB.mediaContents item)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e FilePath
stringParam Text
"filepath" Text
"path of item to lookup"
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"MIME type and contents"
list :: DocumentedFunction PandocError
list :: DocumentedFunction PandocError
list = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"list"
### (unPandocLua (MB.mediaDirectory <$> getMediaBag))
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (FilePath, Text, Int) -> LuaE PandocError ()
pushEntry) Text
"table" Text
"list of entry triples"
where
pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError ()
pushEntry :: (FilePath, Text, Int) -> LuaE PandocError ()
pushEntry (FilePath
fp, Text
mimeType, Int
contentLength) = do
forall e. LuaE e ()
Lua.newtable
forall e. Name -> LuaE e ()
Lua.pushName Name
"path" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. FilePath -> LuaE e ()
Lua.pushString FilePath
fp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
forall e. Name -> LuaE e ()
Lua.pushName Name
"type" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. Pusher e Text
Lua.pushText Text
mimeType forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
forall e. Name -> LuaE e ()
Lua.pushName Name
"length" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a e. (Integral a, Show a) => a -> LuaE e ()
Lua.pushIntegral Int
contentLength forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
fetch :: DocumentedFunction PandocError
fetch :: DocumentedFunction PandocError
fetch = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"fetch"
### (\src -> do
(bs, mimeType) <- unPandocLua $ fetchItem src
Lua.pushText $ fromMaybe "" mimeType
Lua.pushByteString bs
return 2)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"src" Text
"URI to fetch"
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"Returns two string values: the fetched contents and the mimetype."