{-# LANGUAGE LambdaCase        #-}
{-# 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>

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
             , optionalParameter , parameter)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState,
                                      setMediaBag)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
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 :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> Module e
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
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 = Name
-> (FilePath -> LuaE PandocError ())
-> HsFnPrecursor PandocError (FilePath -> LuaE PandocError ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"delete"
  ### (\fp -> unPandocLua $ modifyCommonState
              (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) }))
  HsFnPrecursor PandocError (FilePath -> LuaE PandocError ())
-> Parameter PandocError FilePath
-> HsFnPrecursor PandocError (LuaE PandocError ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError FilePath
-> Text -> Text -> Text -> Parameter PandocError FilePath
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError FilePath
forall e. Peeker e FilePath
Lua.peekString Text
"string" Text
"filepath" Text
"filename of item to delete"
  HsFnPrecursor PandocError (LuaE PandocError ())
-> FunctionResults PandocError () -> DocumentedFunction PandocError
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 = Name
-> LuaE PandocError ()
-> HsFnPrecursor PandocError (LuaE PandocError ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"empty"
  ### unPandocLua (modifyCommonState (\st -> st { stMediaBag = mempty }))
  HsFnPrecursor PandocError (LuaE PandocError ())
-> FunctionResults PandocError () -> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []

-- | Insert a new item into the media bag.
insert :: DocumentedFunction PandocError
insert :: DocumentedFunction PandocError
insert = Name
-> (FilePath
    -> Maybe Text -> ByteString -> LuaE PandocError NumResults)
-> HsFnPrecursor
     PandocError
     (FilePath
      -> Maybe Text -> ByteString -> LuaE PandocError NumResults)
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))
  HsFnPrecursor
  PandocError
  (FilePath
   -> Maybe Text -> ByteString -> LuaE PandocError NumResults)
-> Parameter PandocError FilePath
-> HsFnPrecursor
     PandocError
     (Maybe Text -> ByteString -> LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError FilePath
-> Text -> Text -> Text -> Parameter PandocError FilePath
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError FilePath
forall e. Peeker e FilePath
Lua.peekString Text
"string" Text
"filepath" Text
"item file path"
  HsFnPrecursor
  PandocError
  (Maybe Text -> ByteString -> LuaE PandocError NumResults)
-> Parameter PandocError (Maybe Text)
-> HsFnPrecursor
     PandocError (ByteString -> LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Text
-> Text -> Text -> Text -> Parameter PandocError (Maybe Text)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker PandocError Text
forall e. Peeker e Text
Lua.peekText Text
"string" Text
"mimetype" Text
"the item's MIME type"
  HsFnPrecursor
  PandocError (ByteString -> LuaE PandocError NumResults)
-> Parameter PandocError ByteString
-> HsFnPrecursor PandocError (LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError ByteString
-> Text -> Text -> Text -> Parameter PandocError ByteString
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError ByteString
forall e. Peeker e ByteString
Lua.peekLazyByteString Text
"string" Text
"contents" Text
"binary contents"
  HsFnPrecursor PandocError (LuaE PandocError NumResults)
-> Text -> DocumentedFunction PandocError
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"Nothing"

-- | Returns iterator values to be used with a Lua @for@ loop.
items :: DocumentedFunction PandocError
items :: DocumentedFunction PandocError
items = Name
-> LuaE PandocError NumResults
-> HsFnPrecursor PandocError (LuaE PandocError NumResults)
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))
  HsFnPrecursor PandocError (LuaE PandocError NumResults)
-> Text -> DocumentedFunction PandocError
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 = Name
-> (FilePath -> LuaE PandocError NumResults)
-> HsFnPrecursor
     PandocError (FilePath -> LuaE PandocError NumResults)
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)
  HsFnPrecursor PandocError (FilePath -> LuaE PandocError NumResults)
-> Parameter PandocError FilePath
-> HsFnPrecursor PandocError (LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError FilePath
-> Text -> Text -> Text -> Parameter PandocError FilePath
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError FilePath
forall e. Peeker e FilePath
Lua.peekString Text
"string" Text
"filepath" Text
"path of item to lookup"
  HsFnPrecursor PandocError (LuaE PandocError NumResults)
-> Text -> DocumentedFunction PandocError
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 = Name
-> LuaE PandocError [(FilePath, Text, Int)]
-> HsFnPrecursor
     PandocError (LuaE PandocError [(FilePath, Text, Int)])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"list"
  ### (unPandocLua (MB.mediaDirectory <$> getMediaBag))
  HsFnPrecursor
  PandocError (LuaE PandocError [(FilePath, Text, Int)])
-> FunctionResults PandocError [(FilePath, Text, Int)]
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError [(FilePath, Text, Int)]
-> Text
-> Text
-> FunctionResults PandocError [(FilePath, Text, Int)]
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (Pusher PandocError (FilePath, Text, Int)
-> Pusher PandocError [(FilePath, Text, Int)]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher PandocError (FilePath, Text, Int)
pushEntry) Text
"table" Text
"list of entry triples"
 where
  pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError ()
  pushEntry :: Pusher PandocError (FilePath, Text, Int)
pushEntry (FilePath
fp, Text
mimeType, Int
contentLength) = do
    LuaE PandocError ()
forall e. LuaE e ()
Lua.newtable
    Name -> LuaE PandocError ()
forall e. Name -> LuaE e ()
Lua.pushName Name
"path"   LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> FilePath -> LuaE PandocError ()
forall e. FilePath -> LuaE e ()
Lua.pushString FilePath
fp              LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
    Name -> LuaE PandocError ()
forall e. Name -> LuaE e ()
Lua.pushName Name
"type"   LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pusher PandocError Text
forall e. Pusher e Text
Lua.pushText Text
mimeType          LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (-StackIndex
3)
    Name -> LuaE PandocError ()
forall e. Name -> LuaE e ()
Lua.pushName Name
"length" LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> LuaE PandocError ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
Lua.pushIntegral Int
contentLength LuaE PandocError () -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE PandocError ()
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 = Name
-> (Text -> LuaE PandocError NumResults)
-> HsFnPrecursor PandocError (Text -> LuaE PandocError NumResults)
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)
  HsFnPrecursor PandocError (Text -> LuaE PandocError NumResults)
-> Parameter PandocError Text
-> HsFnPrecursor PandocError (LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError Text
-> Text -> Text -> Text -> Parameter PandocError Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker PandocError Text
forall e. Peeker e Text
Lua.peekText Text
"string" Text
"src" Text
"URI to fetch"
  HsFnPrecursor PandocError (LuaE PandocError NumResults)
-> Text -> DocumentedFunction PandocError
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"Returns two string values: the fetched contents and the mimetype."