{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua.Module.MediaBag
   Copyright   : Copyright © 2017-2022 Albert Krewinkel
   License     : GNU GPL, version 2 or above
   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

The Lua module @pandoc.mediabag@.
-}
module Text.Pandoc.Lua.Module.MediaBag
  ( documentedModule
  ) where

import Prelude hiding (lookup)
import Data.Maybe (fromMaybe)
import HsLua ( LuaE, DocumentedFunction, Module (..)
             , (<#>), (###), (=#>), (=?>), (#?), defun, functionResult
             , opt, parameter, stringParam, textParam)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad (fetchItem, fillMediaBag, getMediaBag,
                                      modifyCommonState, setMediaBag)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc, pushPandoc)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Lua.Orphans ()
import Text.Pandoc.Lua.PandocLua (unPandocLua)
import Text.Pandoc.MIME (MimeType)

import qualified Data.ByteString.Lazy as BL
import qualified HsLua as Lua
import qualified Text.Pandoc.MediaBag as MB

--
-- MediaBag submodule
--
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"pandoc.mediabag"
  , moduleDescription :: Text
moduleDescription = Text
"mediabag access"
  , moduleFields :: [Field PandocError]
moduleFields = []
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions =
      [ DocumentedFunction PandocError
delete
      , DocumentedFunction PandocError
empty
      , DocumentedFunction PandocError
fetch
      , DocumentedFunction PandocError
fill
      , DocumentedFunction PandocError
insert
      , DocumentedFunction PandocError
items
      , DocumentedFunction PandocError
list
      , DocumentedFunction PandocError
lookup
      ]
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  }

-- | Delete a single item from the media bag.
delete :: DocumentedFunction PandocError
delete :: DocumentedFunction PandocError
delete = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"delete"
  ### (\fp -> unPandocLua $ modifyCommonState
              (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) }))
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e FilePath
stringParam Text
"filepath" Text
"filename of item to delete"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []


-- | Delete all items from the media bag.
empty :: DocumentedFunction PandocError
empty :: DocumentedFunction PandocError
empty = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"empty"
  ### unPandocLua (modifyCommonState (\st -> st { stMediaBag = mempty }))
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []

-- | Fill the mediabag with all images in the document that aren't
-- present yet.
fill :: DocumentedFunction PandocError
fill :: DocumentedFunction PandocError
fill = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"fill"
  ### unPandocLua . fillMediaBag
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"doc"
        Text
"document from which to fill the mediabag"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc Text
"Pandoc" Text
"modified document"
  #? ("Fills the mediabag with the images in the given document.\n" <>
      "An image that cannot be retrieved will be replaced with a Span\n" <>
      "of class \"image\" that contains the image description.\n" <>
      "" <>
      "Images for which the mediabag already contains an item will\n" <>
      "not be processed again.")

-- | Insert a new item into the media bag.
insert :: DocumentedFunction PandocError
insert :: DocumentedFunction PandocError
insert = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"insert"
  ### (\fp mmime contents -> unPandocLua $ do
          mb <- getMediaBag
          setMediaBag $ MB.insertMedia fp mmime contents mb
          return (Lua.NumResults 0))
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e FilePath
stringParam Text
"filepath" Text
"item file path"
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Text
textParam Text
"mimetype" Text
"the item's MIME type")
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e ByteString
Lua.peekLazyByteString Text
"string" Text
"contents" Text
"binary contents"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []

-- | Returns iterator values to be used with a Lua @for@ loop.
items :: DocumentedFunction PandocError
items :: DocumentedFunction PandocError
items = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"items"
  ### (do
          mb <-unPandocLua getMediaBag
          let pushItem (fp, mimetype, contents) = do
                Lua.pushString fp
                Lua.pushText mimetype
                Lua.pushByteString $ BL.toStrict contents
                return (Lua.NumResults 3)
          Lua.pushIterator pushItem (MB.mediaItems mb))
  forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"Iterator triple"

-- | Function to lookup a value in the mediabag.
lookup :: DocumentedFunction PandocError
lookup :: DocumentedFunction PandocError
lookup = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"lookup"
  ### (\fp -> unPandocLua (MB.lookupMedia fp <$> getMediaBag) >>= \case
          Nothing   -> 1 <$ Lua.pushnil
          Just item -> 2 <$ do
            Lua.pushText $ MB.mediaMimeType item
            Lua.pushLazyByteString $ MB.mediaContents item)
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e FilePath
stringParam Text
"filepath" Text
"path of item to lookup"
  forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"MIME type and contents"

-- | Function listing all mediabag items.
list :: DocumentedFunction PandocError
list :: DocumentedFunction PandocError
list = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"list"
  ### (unPandocLua (MB.mediaDirectory <$> getMediaBag))
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (FilePath, Text, Int) -> LuaE PandocError ()
pushEntry) Text
"table" Text
"list of entry triples"
 where
  pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError ()
  pushEntry :: (FilePath, Text, Int) -> LuaE PandocError ()
pushEntry (FilePath
fp, Text
mimeType, Int
contentLength) = do
    forall e. LuaE e ()
Lua.newtable
    forall e. Name -> LuaE e ()
Lua.pushName Name
"path"   forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. FilePath -> LuaE e ()
Lua.pushString FilePath
fp              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
    forall e. Name -> LuaE e ()
Lua.pushName Name
"type"   forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. Pusher e Text
Lua.pushText Text
mimeType          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
    forall e. Name -> LuaE e ()
Lua.pushName Name
"length" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a e. (Integral a, Show a) => a -> LuaE e ()
Lua.pushIntegral Int
contentLength forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)

-- | Lua function to retrieve a new item.
fetch :: DocumentedFunction PandocError
fetch :: DocumentedFunction PandocError
fetch = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"fetch"
  ### (\src -> do
          (bs, mimeType) <- unPandocLua $ fetchItem src
          Lua.pushText $ fromMaybe "" mimeType
          Lua.pushByteString bs
          return 2)
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"src" Text
"URI to fetch"
  forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"Returns two string values: the fetched contents and the mimetype."