{-# LANGUAGE NoImplicitPrelude #-}
{- |
   Module      : Text.Pandoc.Lua.Module.MediaBag
   Copyright   : Copyright © 2017-2019 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
import Control.Monad (zipWithM_)
import Foreign.Lua (Lua, NumResults, Optional, liftIO)
import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState,
                          runIOorExplode, 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

--
-- MediaBag submodule
--
pushModule :: Lua NumResults
pushModule :: Lua NumResults
pushModule = do
  Lua ()
Lua.newtable
  String -> (String -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction "delete" String -> Lua NumResults
delete
  String -> Lua NumResults -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction "empty" Lua NumResults
empty
  String
-> (String -> Optional MimeType -> ByteString -> Lua NumResults)
-> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction "insert" String -> Optional MimeType -> ByteString -> Lua NumResults
insertMediaFn
  String -> Lua NumResults -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction "items" Lua NumResults
items
  String -> (String -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction "lookup" String -> Lua NumResults
lookupMediaFn
  String -> Lua NumResults -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction "list" Lua NumResults
mediaDirectoryFn
  String -> (MimeType -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction "fetch" MimeType -> Lua NumResults
fetch
  NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return 1

--
-- Port functions from Text.Pandoc.Class to the Lua monad.
-- TODO: reuse existing functions.

-- Get the current CommonState.
getCommonState :: Lua CommonState
getCommonState :: Lua CommonState
getCommonState = do
  String -> Lua ()
Lua.getglobal "PANDOC_STATE"
  StackIndex -> Lua CommonState
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
Lua.stackTop

-- Replace MediaBag in CommonState.
setCommonState :: CommonState -> Lua ()
setCommonState :: CommonState -> Lua ()
setCommonState st :: CommonState
st = do
  CommonState -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push CommonState
st
  String -> Lua ()
Lua.setglobal "PANDOC_STATE"

modifyCommonState :: (CommonState -> CommonState) -> Lua ()
modifyCommonState :: (CommonState -> CommonState) -> Lua ()
modifyCommonState f :: 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 a single item from the media bag.
delete :: FilePath -> Lua NumResults
delete :: String -> Lua NumResults
delete fp :: String
fp = 0 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (CommonState -> CommonState) -> Lua ()
modifyCommonState
  (\st :: 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 :: Lua NumResults
empty :: Lua NumResults
empty = 0 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (CommonState -> CommonState) -> Lua ()
modifyCommonState (\st :: 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
              -> Lua NumResults
insertMediaFn :: String -> Optional MimeType -> ByteString -> Lua NumResults
insertMediaFn fp :: String
fp optionalMime :: Optional MimeType
optionalMime contents :: ByteString
contents = do
  (CommonState -> CommonState) -> Lua ()
modifyCommonState ((CommonState -> CommonState) -> Lua ())
-> (CommonState -> CommonState) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \st :: 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 0

-- | Returns iterator values to be used with a Lua @for@ loop.
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 fp :: 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
    Nothing -> 1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lua ()
Lua.pushnil
    Just (mimeType :: MimeType
mimeType, contents :: 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 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 [1..] [(String, MimeType, Int)]
dirContents
  NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return 1
 where
  addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> Lua ()
  addEntry :: Integer -> (String, MimeType, Int) -> Lua ()
addEntry idx :: Integer
idx (fp :: String
fp, mimeType :: MimeType
mimeType, contentLength :: Int
contentLength) = do
    Lua ()
Lua.newtable
    String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push "path" 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 (-3)
    String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push "type" 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 (-3)
    String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push "length" 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 (-3)
    StackIndex -> Integer -> Lua ()
Lua.rawseti (-2) Integer
idx

fetch :: T.Text
      -> Lua NumResults
fetch :: MimeType -> Lua NumResults
fetch src :: MimeType
src = do
  CommonState
commonState <- Lua CommonState
getCommonState
  let mediaBag :: MediaBag
mediaBag = CommonState -> MediaBag
stMediaBag CommonState
commonState
  (bs :: ByteString
bs, mimeType :: 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 "" 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 2 -- returns 2 values: contents, mimetype