{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua.Module.MediaBag
   Copyright   : Copyright © 2017-2020 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 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
insertMediaFn
  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
lookupMediaFn
  String -> PandocLua NumResults -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"list" PandocLua NumResults
mediaDirectoryFn
  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.
insertMediaFn :: FilePath
              -> Optional MimeType
              -> BL.ByteString
              -> PandocLua NumResults
insertMediaFn :: String -> Optional MimeType -> ByteString -> PandocLua NumResults
insertMediaFn 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

lookupMediaFn :: FilePath
              -> PandocLua NumResults
lookupMediaFn :: String -> PandocLua NumResults
lookupMediaFn String
fp = do
  Maybe (MimeType, ByteString)
res <- String -> MediaBag -> Maybe (MimeType, ByteString)
MB.lookupMedia String
fp (MediaBag -> Maybe (MimeType, ByteString))
-> PandocLua MediaBag -> PandocLua (Maybe (MimeType, ByteString))
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 (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 :: PandocLua NumResults
mediaDirectoryFn :: PandocLua NumResults
mediaDirectoryFn = 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