{-# 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 Text -> ByteString -> PandocLua NumResults)
-> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"insert" String -> Optional Text -> 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 -> (Text -> PandocLua NumResults) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"fetch" Text -> 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 Text -> ByteString -> PandocLua NumResults
insert String
fp Optional Text
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 Text -> ByteString -> MediaBag -> MediaBag
MB.insertMedia String
fp (Optional Text -> Maybe Text
forall a. Optional a -> Maybe a
Lua.fromOptional Optional Text
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 (Text, ByteString)
res <- String -> MediaBag -> Maybe (Text, ByteString)
MB.lookupMedia String
fp (MediaBag -> Maybe (Text, ByteString))
-> PandocLua MediaBag -> PandocLua (Maybe (Text, 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 (Text, ByteString)
res of
    Maybe (Text, ByteString)
Nothing -> NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lua ()
Lua.pushnil
    Just (Text
mimeType, ByteString
contents) -> do
      Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Text
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

list :: PandocLua NumResults
list :: PandocLua NumResults
list = do
  [(String, Text, Int)]
dirContents <- MediaBag -> [(String, Text, Int)]
MB.mediaDirectory (MediaBag -> [(String, Text, Int)])
-> PandocLua MediaBag -> PandocLua [(String, Text, 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, Text, Int) -> Lua ())
-> [Integer] -> [(String, Text, Int)] -> Lua ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Integer -> (String, Text, Int) -> Lua ()
addEntry [Integer
1..] [(String, Text, 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, Text, Int) -> Lua ()
addEntry Integer
idx (String
fp, Text
mimeType, Int
contentLength) = do
    Lua ()
Lua.newtable
    Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Text
"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)
    Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Text
"type" :: T.Text) Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Text
mimeType Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
Lua.rawset (-StackIndex
3)
    Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Text
"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 :: Text -> PandocLua NumResults
fetch Text
src = do
  (ByteString
bs, Maybe Text
mimeType) <- Text -> PandocLua (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
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 -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Text -> String
T.unpack Maybe Text
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