Merge pull request #5312 from tarleb/pandoc-mediabag-extension

Pandoc mediabag extension

3 files changed, 110 insertions, 2 deletions

diff --git a/src/Text/Pandoc/Lua/Marshaling/MediaBag.hs b/src/Text/Pandoc/Lua/Marshaling/MediaBag.hs
new file mode 100644
index 000000000..816843c1d
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Marshaling/MediaBag.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE NoImplicitPrelude    #-}
+{- |
+   Module      : Text.Pandoc.Lua.Marshaling.MediaBag
+   Copyright   : © 2012-2019 John MacFarlane
+                 © 2017-2019 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   Stability   : alpha
+
+Instances to marshal (push) and unmarshal (peek) media data.
+-}
+module Text.Pandoc.Lua.Marshaling.MediaBag (pushIterator) where
+
+import Prelude
+import Foreign.Ptr (Ptr)
+import Foreign.StablePtr (StablePtr, deRefStablePtr, newStablePtr)
+import Foreign.Lua (Lua, NumResults, Peekable, Pushable, StackIndex)
+import Foreign.Lua.Types.Peekable (reportValueOnFailure)
+import Foreign.Lua.Userdata (ensureUserdataMetatable, pushAnyWithMetatable,
+                             toAnyWithName)
+import Text.Pandoc.MediaBag (MediaBag, mediaItems)
+import Text.Pandoc.MIME (MimeType)
+import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))
+
+import qualified Data.ByteString.Lazy as BL
+import qualified Foreign.Lua as Lua
+import qualified Foreign.Storable as Storable
+
+-- | A list of 'MediaBag' items.
+newtype MediaItems = MediaItems [(String, MimeType, BL.ByteString)]
+
+instance Pushable MediaItems where
+  push = pushMediaItems
+
+instance Peekable MediaItems where
+  peek = peekMediaItems
+
+-- | Push an iterator triple to be used with Lua's @for@ loop construct.
+-- Each iterator invokation returns a tripple consisting of an item's
+-- filename, MIME type, and content.
+pushIterator :: MediaBag -> Lua NumResults
+pushIterator mb = do
+  Lua.pushHaskellFunction nextItem
+  Lua.push (MediaItems $ mediaItems mb)
+  Lua.pushnil
+  return 3
+
+-- | Lua type name for @'MediaItems'@.
+mediaItemsTypeName :: String
+mediaItemsTypeName = "pandoc MediaItems"
+
+-- | Push a @MediaItems@ element to the stack.
+pushMediaItems :: MediaItems -> Lua ()
+pushMediaItems xs = pushAnyWithMetatable pushMT xs
+ where
+  pushMT = ensureUserdataMetatable mediaItemsTypeName (return ())
+
+-- | Retrieve a @MediaItems@ element from the stack.
+peekMediaItems :: StackIndex -> Lua MediaItems
+peekMediaItems = reportValueOnFailure mediaItemsTypeName
+                 (`toAnyWithName` mediaItemsTypeName)
+
+-- | Retrieve a list of items from an iterator state, return the first
+-- item (if present), and advance the state.
+nextItem :: Ptr (StablePtr MediaItems) -> AnyValue -> Lua NumResults
+nextItem ptr _ = do
+  (MediaItems items) <- Lua.liftIO $ deRefStablePtr =<< Storable.peek ptr
+  case items of
+    [] -> 2 <$ (Lua.pushnil *> Lua.pushnil)
+    (key, mt, content):xs -> do
+      Lua.liftIO $ Storable.poke ptr =<< newStablePtr (MediaItems xs)
+      Lua.push key
+      Lua.push mt
+      Lua.push content
+      return 3
diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 52aeaa1af..261785665 100644
--- a/src/Text/Pandoc/Lua/Module/MediaBag.hs
+++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -20,6 +20,7 @@ import Foreign.Lua (Lua, NumResults, Optional, liftIO)
 import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState,
                           runIOorExplode, setMediaBag)
 import Text.Pandoc.Lua.Marshaling ()
+import Text.Pandoc.Lua.Marshaling.MediaBag (pushIterator)
 import Text.Pandoc.Lua.Util (addFunction)
 import Text.Pandoc.MIME (MimeType)
 
@@ -33,7 +34,10 @@ import qualified Text.Pandoc.MediaBag as MB
 pushModule :: Lua NumResults
 pushModule = do
   Lua.newtable
+  addFunction "delete" delete
+  addFunction "empty" empty
   addFunction "insert" insertMediaFn
+  addFunction "items" items
   addFunction "lookup" lookupMediaFn
   addFunction "list" mediaDirectoryFn
   addFunction "fetch" fetch
@@ -58,6 +62,16 @@ setCommonState st = do
 modifyCommonState :: (CommonState -> CommonState) -> Lua ()
 modifyCommonState f = getCommonState >>= setCommonState . f
 
+-- | Delete a single item from the media bag.
+delete :: FilePath -> Lua NumResults
+delete fp = 0 <$ modifyCommonState
+  (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) })
+
+-- | Delete all items from the media bag.
+empty :: Lua NumResults
+empty = 0 <$ modifyCommonState (\st -> st { stMediaBag = mempty })
+
+-- | Insert a new item into the media bag.
 insertMediaFn :: FilePath
               -> Optional MimeType
               -> BL.ByteString
@@ -66,15 +80,19 @@ insertMediaFn fp optionalMime contents = do
   modifyCommonState $ \st ->
     let mb = MB.insertMedia fp (Lua.fromOptional optionalMime) contents
                                (stMediaBag st)
-    in st { stMediaBag = mb}
+    in st { stMediaBag = mb }
   return 0
 
+-- | Returns iterator values to be used with a Lua @for@ loop.
+items :: Lua NumResults
+items = stMediaBag <$> getCommonState >>= pushIterator
+
 lookupMediaFn :: FilePath
               -> Lua NumResults
 lookupMediaFn fp = do
   res <- MB.lookupMedia fp . stMediaBag <$> getCommonState
   case res of
-    Nothing -> Lua.pushnil *> return 1
+    Nothing -> 1 <$ Lua.pushnil
     Just (mimeType, contents) -> do
       Lua.push mimeType
       Lua.push contents
diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs
index f1e811232..bb6fc88ac 100644
--- a/src/Text/Pandoc/MediaBag.hs
+++ b/src/Text/Pandoc/MediaBag.hs
@@ -16,9 +16,11 @@ interface for interacting with it.
 -}
 module Text.Pandoc.MediaBag (
                      MediaBag,
+                     deleteMedia,
                      lookupMedia,
                      insertMedia,
                      mediaDirectory,
+                     mediaItems
                      ) where
 import Prelude
 import qualified Data.ByteString.Lazy as BL
@@ -40,6 +42,14 @@ newtype MediaBag = MediaBag (M.Map [String] (MimeType, BL.ByteString))
 instance Show MediaBag where
   show bag = "MediaBag " ++ show (mediaDirectory bag)
 
+-- | Delete a media item from a 'MediaBag', or do nothing if no item corresponds
+-- to the given path.
+deleteMedia :: FilePath       -- ^ relative path and canonical name of resource
+            -> MediaBag
+            -> MediaBag
+deleteMedia fp (MediaBag mediamap) =
+  MediaBag $ M.delete (splitDirectories fp) mediamap
+
 -- | Insert a media item into a 'MediaBag', replacing any existing
 -- value with the same name.
 insertMedia :: FilePath       -- ^ relative path and canonical name of resource
@@ -66,3 +76,8 @@ mediaDirectory :: MediaBag -> [(String, MimeType, Int)]
 mediaDirectory (MediaBag mediamap) =
   M.foldrWithKey (\fp (mime,contents) ->
       ((Posix.joinPath fp, mime, fromIntegral $ BL.length contents):)) [] mediamap
+
+mediaItems :: MediaBag -> [(String, MimeType, BL.ByteString)]
+mediaItems (MediaBag mediamap) =
+  M.foldrWithKey (\fp (mime,contents) ->
+      ((Posix.joinPath fp, mime, contents):)) [] mediamap