{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua.Module.MediaBag
   Copyright   : Copyright © 2017-2021 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 Prelude hiding (lookup)
import Control.Monad (zipWithM_)
import HsLua (LuaE, NumResults, Optional)
import HsLua.Marshalling (pushIterator)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState,
                                      setMediaBag)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua, addFunction)
import Text.Pandoc.MIME (MimeType)

import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified HsLua as Lua
import qualified Text.Pandoc.MediaBag as MB

--
-- MediaBag submodule
--
pushModule :: PandocLua NumResults
pushModule :: PandocLua NumResults
pushModule = do
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError ()
forall e. LuaE e ()
Lua.newtable
  Name -> (FilePath -> PandocLua NumResults) -> PandocLua ()
forall a. Exposable PandocError a => Name -> a -> PandocLua ()
addFunction Name
"delete" FilePath -> PandocLua NumResults
delete
  Name -> PandocLua NumResults -> PandocLua ()
forall a. Exposable PandocError a => Name -> a -> PandocLua ()
addFunction Name
"empty" PandocLua NumResults
empty
  Name
-> (FilePath
    -> Optional MimeType -> ByteString -> PandocLua NumResults)
-> PandocLua ()
forall a. Exposable PandocError a => Name -> a -> PandocLua ()
addFunction Name
"insert" FilePath -> Optional MimeType -> ByteString -> PandocLua NumResults
insert
  Name -> PandocLua NumResults -> PandocLua ()
forall a. Exposable PandocError a => Name -> a -> PandocLua ()
addFunction Name
"items" PandocLua NumResults
items
  Name -> (FilePath -> PandocLua NumResults) -> PandocLua ()
forall a. Exposable PandocError a => Name -> a -> PandocLua ()
addFunction Name
"lookup" FilePath -> PandocLua NumResults
lookup
  Name -> PandocLua NumResults -> PandocLua ()
forall a. Exposable PandocError a => Name -> a -> PandocLua ()
addFunction Name
"list" PandocLua NumResults
list
  Name -> (MimeType -> PandocLua NumResults) -> PandocLua ()
forall a. Exposable PandocError a => Name -> a -> PandocLua ()
addFunction Name
"fetch" MimeType -> PandocLua NumResults
fetch
  NumResults -> PandocLua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1

-- | Delete a single item from the media bag.
delete :: FilePath -> PandocLua NumResults
delete :: FilePath -> PandocLua NumResults
delete FilePath
fp = NumResults
0 NumResults -> PandocLua () -> PandocLua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (CommonState -> CommonState) -> PandocLua ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState
  (\CommonState
st -> CommonState
st { stMediaBag :: MediaBag
stMediaBag = FilePath -> MediaBag -> MediaBag
MB.deleteMedia FilePath
fp (CommonState -> MediaBag
stMediaBag CommonState
st) })

-- | Delete all items from the media bag.
empty :: PandocLua NumResults
empty :: PandocLua NumResults
empty = NumResults
0 NumResults -> PandocLua () -> PandocLua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (CommonState -> CommonState) -> PandocLua ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState (\CommonState
st -> CommonState
st { stMediaBag :: MediaBag
stMediaBag = MediaBag
forall a. Monoid a => a
mempty })

-- | Insert a new item into the media bag.
insert :: FilePath
       -> Optional MimeType
       -> BL.ByteString
       -> PandocLua NumResults
insert :: FilePath -> Optional MimeType -> ByteString -> PandocLua NumResults
insert FilePath
fp Optional MimeType
optionalMime ByteString
contents = do
  MediaBag
mb <- PandocLua MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  MediaBag -> PandocLua ()
forall (m :: * -> *). PandocMonad m => MediaBag -> m ()
setMediaBag (MediaBag -> PandocLua ()) -> MediaBag -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe MimeType -> ByteString -> MediaBag -> MediaBag
MB.insertMedia FilePath
fp (Optional MimeType -> Maybe MimeType
forall a. Optional a -> Maybe a
Lua.fromOptional Optional MimeType
optionalMime) ByteString
contents MediaBag
mb
  NumResults -> PandocLua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
Lua.NumResults CInt
0)

-- | Returns iterator values to be used with a Lua @for@ loop.
items :: PandocLua NumResults
items :: PandocLua NumResults
items = do
  MediaBag
mb <- PandocLua MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  LuaE PandocError NumResults -> PandocLua NumResults
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError NumResults -> PandocLua NumResults)
-> LuaE PandocError NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ do
    let pushItem :: (FilePath, MimeType, ByteString) -> LuaE e NumResults
pushItem (FilePath
fp, MimeType
mimetype, ByteString
contents) = do
          FilePath -> LuaE e ()
forall e. FilePath -> LuaE e ()
Lua.pushString FilePath
fp
          Pusher e MimeType
forall e. Pusher e MimeType
Lua.pushText MimeType
mimetype
          Pusher e ByteString
forall e. Pusher e ByteString
Lua.pushByteString Pusher e ByteString -> Pusher e ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
contents
          NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
Lua.NumResults CInt
3)
    ((FilePath, MimeType, ByteString) -> LuaE PandocError NumResults)
-> [(FilePath, MimeType, ByteString)]
-> LuaE PandocError NumResults
forall a e.
LuaError e =>
(a -> LuaE e NumResults) -> [a] -> LuaE e NumResults
pushIterator (FilePath, MimeType, ByteString) -> LuaE PandocError NumResults
forall e. (FilePath, MimeType, ByteString) -> LuaE e NumResults
pushItem (MediaBag -> [(FilePath, MimeType, ByteString)]
MB.mediaItems MediaBag
mb)

lookup :: FilePath
       -> PandocLua NumResults
lookup :: FilePath -> PandocLua NumResults
lookup FilePath
fp = do
  Maybe MediaItem
res <- FilePath -> MediaBag -> Maybe MediaItem
MB.lookupMedia FilePath
fp (MediaBag -> Maybe MediaItem)
-> PandocLua MediaBag -> PandocLua (Maybe MediaItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PandocLua MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  LuaE PandocError NumResults -> PandocLua NumResults
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError NumResults -> PandocLua NumResults)
-> LuaE PandocError NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ case Maybe MediaItem
res of
    Maybe MediaItem
Nothing -> NumResults
1 NumResults -> LuaE PandocError () -> LuaE PandocError NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LuaE PandocError ()
forall e. LuaE e ()
Lua.pushnil
    Just MediaItem
item -> do
      MimeType -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (MimeType -> LuaE PandocError ())
-> MimeType -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ MediaItem -> MimeType
MB.mediaMimeType MediaItem
item
      ByteString -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (ByteString -> LuaE PandocError ())
-> ByteString -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ MediaItem -> ByteString
MB.mediaContents MediaItem
item
      NumResults -> LuaE PandocError NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
2

list :: PandocLua NumResults
list :: PandocLua NumResults
list = do
  [(FilePath, MimeType, Int)]
dirContents <- MediaBag -> [(FilePath, MimeType, Int)]
MB.mediaDirectory (MediaBag -> [(FilePath, MimeType, Int)])
-> PandocLua MediaBag -> PandocLua [(FilePath, MimeType, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PandocLua MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
    LuaE PandocError ()
forall e. LuaE e ()
Lua.newtable
    (Integer -> (FilePath, MimeType, Int) -> LuaE PandocError ())
-> [Integer] -> [(FilePath, MimeType, Int)] -> LuaE PandocError ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Integer -> (FilePath, MimeType, Int) -> LuaE PandocError ()
addEntry [Integer
1..] [(FilePath, MimeType, Int)]
dirContents
  NumResults -> PandocLua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
 where
  addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> LuaE PandocError ()
  addEntry :: Integer -> (FilePath, MimeType, Int) -> LuaE PandocError ()
addEntry Integer
idx (FilePath
fp, MimeType
mimeType, Int
contentLength) = do
    LuaE PandocError ()
forall e. LuaE e ()
Lua.newtable
    MimeType -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (MimeType
"path" :: T.Text) LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> FilePath -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push FilePath
fp LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
    MimeType -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (MimeType
"type" :: T.Text) LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MimeType -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push MimeType
mimeType LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
    MimeType -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (MimeType
"length" :: T.Text) LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Int
contentLength LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
    StackIndex -> Integer -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawseti (-StackIndex
2) Integer
idx

fetch :: T.Text
      -> PandocLua NumResults
fetch :: MimeType -> PandocLua NumResults
fetch MimeType
src = do
  (ByteString
bs, Maybe MimeType
mimeType) <- MimeType -> PandocLua (ByteString, Maybe MimeType)
forall (m :: * -> *).
PandocMonad m =>
MimeType -> m (ByteString, Maybe MimeType)
fetchItem MimeType
src
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> (FilePath -> LuaE PandocError ()) -> FilePath -> PandocLua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (FilePath -> PandocLua ()) -> FilePath -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (MimeType -> FilePath) -> Maybe MimeType -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" MimeType -> FilePath
T.unpack Maybe MimeType
mimeType
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ ByteString -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push ByteString
bs
  NumResults -> PandocLua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
2 -- returns 2 values: contents, mimetype