{-# 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 Foreign.Lua (Lua, NumResults, Optional)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState,
                                      setMediaBag)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Marshaling.MediaBag (pushIterator)
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 Foreign.Lua as Lua
import qualified Text.Pandoc.MediaBag as MB

--
-- MediaBag submodule
--
pushModule :: PandocLua NumResults
pushModule :: PandocLua NumResults
pushModule = do
  Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua Lua ()
Lua.newtable
  String -> (String -> PandocLua NumResults) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"delete" String -> PandocLua NumResults
delete
  String -> PandocLua NumResults -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"empty" PandocLua NumResults
empty
  String
-> (String
    -> Optional MimeType -> ByteString -> PandocLua NumResults)
-> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"insert" String -> Optional MimeType -> ByteString -> PandocLua NumResults
insert
  String -> PandocLua NumResults -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"items" PandocLua NumResults
items
  String -> (String -> PandocLua NumResults) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"lookup" String -> PandocLua NumResults
lookup
  String -> PandocLua NumResults -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"list" PandocLua NumResults
list
  String -> (MimeType -> PandocLua NumResults) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"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 :: String -> PandocLua NumResults
delete String
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 = String -> MediaBag -> MediaBag
MB.deleteMedia String
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 :: String -> Optional MimeType -> ByteString -> PandocLua NumResults
insert String
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
$ 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 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 = PandocLua MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag PandocLua MediaBag
-> (MediaBag -> PandocLua NumResults) -> PandocLua NumResults
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Lua NumResults -> PandocLua NumResults
forall a. Lua a -> PandocLua a
liftPandocLua (Lua NumResults -> PandocLua NumResults)
-> (MediaBag -> Lua NumResults) -> MediaBag -> PandocLua NumResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaBag -> Lua NumResults
pushIterator

lookup :: FilePath
       -> PandocLua NumResults
lookup :: String -> PandocLua NumResults
lookup String
fp = do
  Maybe MediaItem
res <- String -> MediaBag -> Maybe MediaItem
MB.lookupMedia String
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
  Lua NumResults -> PandocLua NumResults
forall a. Lua a -> PandocLua a
liftPandocLua (Lua NumResults -> PandocLua NumResults)
-> Lua NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ case Maybe MediaItem
res of
    Maybe MediaItem
Nothing -> NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lua ()
Lua.pushnil
    Just MediaItem
item -> do
      MimeType -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (MimeType -> Lua ()) -> MimeType -> Lua ()
forall a b. (a -> b) -> a -> b
$ MediaItem -> MimeType
MB.mediaMimeType MediaItem
item
      ByteString -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (ByteString -> Lua ()) -> ByteString -> Lua ()
forall a b. (a -> b) -> a -> b
$ MediaItem -> ByteString
MB.mediaContents MediaItem
item
      NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
2

list :: PandocLua NumResults
list :: PandocLua NumResults
list = do
  [(String, MimeType, Int)]
dirContents <- MediaBag -> [(String, MimeType, Int)]
MB.mediaDirectory (MediaBag -> [(String, MimeType, Int)])
-> PandocLua MediaBag -> PandocLua [(String, MimeType, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PandocLua MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua (Lua () -> PandocLua ()) -> Lua () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
    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 -> PandocLua 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
      -> 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
  Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua (Lua () -> PandocLua ())
-> (String -> Lua ()) -> String -> PandocLua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String -> PandocLua ()) -> String -> PandocLua ()
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
  Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua (Lua () -> PandocLua ()) -> Lua () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push ByteString
bs
  NumResults -> PandocLua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
2 -- returns 2 values: contents, mimetype