    {-# 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, liftIO)
    import Text.Pandoc.Class.CommonState (CommonState (..))
    import Text.Pandoc.Class.PandocIO (runIOorExplode)
    import Text.Pandoc.Class.PandocMonad (fetchItem, putCommonState, 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
        MimeType -> Lua ()
    forall a. Pushable a => a -> Lua ()
    Lua.push ("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 (-3)
        MimeType -> Lua ()
    forall a. Pushable a => a -> Lua ()
    Lua.push ("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 (-3)
        MimeType -> Lua ()
    forall a. Pushable a => a -> Lua ()
    Lua.push ("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 (-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