{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Module.MediaBag
( pushModule
) where
import Control.Monad (zipWithM_)
import Foreign.Lua (Lua, NumResults, Optional, liftIO)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocIO (runIOorExplode)
import Text.Pandoc.Class.PandocMonad (fetchItem, putCommonState, setMediaBag)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Marshaling.MediaBag (pushIterator)
import Text.Pandoc.Lua.Util (addFunction)
import Text.Pandoc.MIME (MimeType)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.MediaBag as MB
pushModule :: Lua NumResults
pushModule :: Lua NumResults
pushModule = do
Lua ()
Lua.newtable
String -> (String -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction String
"delete" String -> Lua NumResults
delete
String -> Lua NumResults -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction String
"empty" Lua NumResults
empty
String
-> (String -> Optional MimeType -> ByteString -> Lua NumResults)
-> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction String
"insert" String -> Optional MimeType -> ByteString -> Lua NumResults
insertMediaFn
String -> Lua NumResults -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction String
"items" Lua NumResults
items
String -> (String -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction String
"lookup" String -> Lua NumResults
lookupMediaFn
String -> Lua NumResults -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction String
"list" Lua NumResults
mediaDirectoryFn
String -> (MimeType -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction String
"fetch" MimeType -> Lua NumResults
fetch
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
getCommonState :: Lua CommonState
getCommonState :: Lua CommonState
getCommonState = do
String -> Lua ()
Lua.getglobal String
"PANDOC_STATE"
StackIndex -> Lua CommonState
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
Lua.stackTop
setCommonState :: CommonState -> Lua ()
setCommonState :: CommonState -> Lua ()
setCommonState CommonState
st = do
CommonState -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push CommonState
st
String -> Lua ()
Lua.setglobal String
"PANDOC_STATE"
modifyCommonState :: (CommonState -> CommonState) -> Lua ()
modifyCommonState :: (CommonState -> CommonState) -> Lua ()
modifyCommonState CommonState -> CommonState
f = Lua CommonState
getCommonState Lua CommonState -> (CommonState -> Lua ()) -> Lua ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CommonState -> Lua ()
setCommonState (CommonState -> Lua ())
-> (CommonState -> CommonState) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> CommonState
f
delete :: FilePath -> Lua NumResults
delete :: String -> Lua NumResults
delete String
fp = NumResults
0 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (CommonState -> CommonState) -> Lua ()
modifyCommonState
(\CommonState
st -> CommonState
st { stMediaBag :: MediaBag
stMediaBag = String -> MediaBag -> MediaBag
MB.deleteMedia String
fp (CommonState -> MediaBag
stMediaBag CommonState
st) })
empty :: Lua NumResults
empty :: Lua NumResults
empty = NumResults
0 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (CommonState -> CommonState) -> Lua ()
modifyCommonState (\CommonState
st -> CommonState
st { stMediaBag :: MediaBag
stMediaBag = MediaBag
forall a. Monoid a => a
mempty })
insertMediaFn :: FilePath
-> Optional MimeType
-> BL.ByteString
-> Lua NumResults
insertMediaFn :: String -> Optional MimeType -> ByteString -> Lua NumResults
insertMediaFn String
fp Optional MimeType
optionalMime ByteString
contents = do
(CommonState -> CommonState) -> Lua ()
modifyCommonState ((CommonState -> CommonState) -> Lua ())
-> (CommonState -> CommonState) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st ->
let mb :: MediaBag
mb = String -> Maybe MimeType -> ByteString -> MediaBag -> MediaBag
MB.insertMedia String
fp (Optional MimeType -> Maybe MimeType
forall a. Optional a -> Maybe a
Lua.fromOptional Optional MimeType
optionalMime) ByteString
contents
(CommonState -> MediaBag
stMediaBag CommonState
st)
in CommonState
st { stMediaBag :: MediaBag
stMediaBag = MediaBag
mb }
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
0
items :: Lua NumResults
items :: Lua NumResults
items = CommonState -> MediaBag
stMediaBag (CommonState -> MediaBag) -> Lua CommonState -> Lua MediaBag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua CommonState
getCommonState Lua MediaBag -> (MediaBag -> Lua NumResults) -> Lua NumResults
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MediaBag -> Lua NumResults
pushIterator
lookupMediaFn :: FilePath
-> Lua NumResults
lookupMediaFn :: String -> Lua NumResults
lookupMediaFn String
fp = do
Maybe (MimeType, ByteString)
res <- String -> MediaBag -> Maybe (MimeType, ByteString)
MB.lookupMedia String
fp (MediaBag -> Maybe (MimeType, ByteString))
-> (CommonState -> MediaBag)
-> CommonState
-> Maybe (MimeType, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> MediaBag
stMediaBag (CommonState -> Maybe (MimeType, ByteString))
-> Lua CommonState -> Lua (Maybe (MimeType, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua CommonState
getCommonState
case Maybe (MimeType, ByteString)
res of
Maybe (MimeType, ByteString)
Nothing -> NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lua ()
Lua.pushnil
Just (MimeType
mimeType, ByteString
contents) -> do
MimeType -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push MimeType
mimeType
ByteString -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push ByteString
contents
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
2
mediaDirectoryFn :: Lua NumResults
mediaDirectoryFn :: Lua NumResults
mediaDirectoryFn = do
[(String, MimeType, Int)]
dirContents <- MediaBag -> [(String, MimeType, Int)]
MB.mediaDirectory (MediaBag -> [(String, MimeType, Int)])
-> (CommonState -> MediaBag)
-> CommonState
-> [(String, MimeType, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> MediaBag
stMediaBag (CommonState -> [(String, MimeType, Int)])
-> Lua CommonState -> Lua [(String, MimeType, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua CommonState
getCommonState
Lua ()
Lua.newtable
(Integer -> (String, MimeType, Int) -> Lua ())
-> [Integer] -> [(String, MimeType, Int)] -> Lua ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Integer -> (String, MimeType, Int) -> Lua ()
addEntry [Integer
1..] [(String, MimeType, Int)]
dirContents
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
where
addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> Lua ()
addEntry :: Integer -> (String, MimeType, Int) -> Lua ()
addEntry Integer
idx (String
fp, MimeType
mimeType, Int
contentLength) = do
Lua ()
Lua.newtable
MimeType -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (MimeType
"path" :: T.Text) Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
fp Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
Lua.rawset (-StackIndex
3)
MimeType -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (MimeType
"type" :: T.Text) Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MimeType -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push MimeType
mimeType Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
Lua.rawset (-StackIndex
3)
MimeType -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (MimeType
"length" :: T.Text) Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Int
contentLength Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
Lua.rawset (-StackIndex
3)
StackIndex -> Integer -> Lua ()
Lua.rawseti (-StackIndex
2) Integer
idx
fetch :: T.Text
-> Lua NumResults
fetch :: MimeType -> Lua NumResults
fetch MimeType
src = do
CommonState
commonState <- Lua CommonState
getCommonState
let mediaBag :: MediaBag
mediaBag = CommonState -> MediaBag
stMediaBag CommonState
commonState
(ByteString
bs, Maybe MimeType
mimeType) <- IO (ByteString, Maybe MimeType) -> Lua (ByteString, Maybe MimeType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ByteString, Maybe MimeType)
-> Lua (ByteString, Maybe MimeType))
-> (PandocIO (ByteString, Maybe MimeType)
-> IO (ByteString, Maybe MimeType))
-> PandocIO (ByteString, Maybe MimeType)
-> Lua (ByteString, Maybe MimeType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocIO (ByteString, Maybe MimeType)
-> IO (ByteString, Maybe MimeType)
forall a. PandocIO a -> IO a
runIOorExplode (PandocIO (ByteString, Maybe MimeType)
-> Lua (ByteString, Maybe MimeType))
-> PandocIO (ByteString, Maybe MimeType)
-> Lua (ByteString, Maybe MimeType)
forall a b. (a -> b) -> a -> b
$ do
CommonState -> PandocIO ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
commonState
MediaBag -> PandocIO ()
forall (m :: * -> *). PandocMonad m => MediaBag -> m ()
setMediaBag MediaBag
mediaBag
MimeType -> PandocIO (ByteString, Maybe MimeType)
forall (m :: * -> *).
PandocMonad m =>
MimeType -> m (ByteString, Maybe MimeType)
fetchItem MimeType
src
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String -> Lua ()) -> String -> Lua ()
forall a b. (a -> b) -> a -> b
$ String -> (MimeType -> String) -> Maybe MimeType -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" MimeType -> String
T.unpack Maybe MimeType
mimeType
ByteString -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push ByteString
bs
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
2