{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua.Module.MediaBag
   Copyright   : Copyright © 2017-2023 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 Data.Version (makeVersion)
import HsLua ( LuaE, DocumentedFunction, Module (..)
             , (<#>), (###), (=#>), (=?>), (#?), defun, functionResult
             , opt, parameter, since, stringParam, textParam)
import Text.Pandoc.Class ( CommonState (..), fetchItem, fillMediaBag
                         , getMediaBag, modifyCommonState, setMediaBag)
import Text.Pandoc.Class.IO (writeMedia)
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 Data.Text as T
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] -> Text
T.unlines
    [ Text
"The `pandoc.mediabag` module allows accessing pandoc's media"
    , Text
"storage. The \"media bag\" is used when pandoc is called with the"
    , Text
"`--extract-media` or (for HTML only) `--embed-resources` option."
    , Text
""
    , Text
"The module is loaded as part of module `pandoc` and can either"
    , Text
"be accessed via the `pandoc.mediabag` field, or explicitly"
    , Text
"required, e.g.:"
    , Text
""
    , Text
"    local mb = require 'pandoc.mediabag'"
    ]
  , moduleFields :: [Field PandocError]
moduleFields = []
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions =
      [ DocumentedFunction PandocError
delete  forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
2,Int
7,Int
3]
      , DocumentedFunction PandocError
empty   forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
2,Int
7,Int
3]
      , DocumentedFunction PandocError
fetch   forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
2,Int
0]
      , DocumentedFunction PandocError
fill    forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
2,Int
19]
      , DocumentedFunction PandocError
insert  forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
2,Int
0]
      , DocumentedFunction PandocError
items   forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
2,Int
7,Int
3]
      , DocumentedFunction PandocError
list    forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
2,Int
0]
      , DocumentedFunction PandocError
lookup  forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
2,Int
0]
      , DocumentedFunction PandocError
write   forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3,Int
0]
      ]
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  , moduleTypeInitializers :: [LuaE PandocError Name]
moduleTypeInitializers = []
  }

-- | 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 String
stringParam Text
"filepath"
      (Text
"Filename of the item to deleted. The media bag will be " forall a. Semigroup a => a -> a -> a
<>
       Text
"left unchanged if no entry with the given filename exists.")
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
  #? "Removes a single entry from the media bag."

-- | 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
=#> []
  #? "Clear-out the media bag, deleting all items."

-- | 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 -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc TypeSpec
"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 -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc TypeSpec
"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" <>
      "\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 String
stringParam Text
"filepath" Text
"filename and path relative to the output folder."
  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; omit if unknown or unavailable.")
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e ByteString
Lua.peekLazyByteString TypeSpec
"string" Text
"contents"
        Text
"the binary contents of the file."
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
  #? T.unlines
  [ "Adds a new entry to pandoc's media bag. Replaces any existing"
  , "media bag entry the same `filepath`."
  , ""
  , "Usage:"
  , ""
  , "    local fp = 'media/hello.txt'"
  , "    local mt = 'text/plain'"
  , "    local contents = 'Hello, World!'"
  , "    pandoc.mediabag.insert(fp, mt, contents)"
  ]

-- | 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] -> Text
T.unlines
  [ Text
"Iterator triple:"
  , Text
""
  , Text
"-   The iterator function; must be called with the iterator"
  , Text
"    state and the current iterator value."
  , Text
"-   Iterator state -- an opaque value to be passed to the"
  , Text
"    iterator function."
  , Text
"-   Initial iterator value."
  ]
  #? T.unlines
  [ "Returns an iterator triple to be used with Lua's generic `for`"
  , "statement. The iterator returns the filepath, MIME type, and"
  , "content of a media bag item on each invocation. Items are"
  , "processed one-by-one to avoid excessive memory use."
  , ""
  , "This function should be used only when full access to all items,"
  , "including their contents, is required. For all other cases,"
  , "[`list`](#pandoc.mediabag.list) should be preferred."
  , ""
  , "Usage:"
  , ""
  , "    for fp, mt, contents in pandoc.mediabag.items() do"
  , "      -- print(fp, mt, contents)"
  , "    end"
  ]

-- | 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))
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e String
stringParam Text
"filepath" Text
"name of the file to look up."
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall a. Monoid a => [a] -> a
mconcat
      [ forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult
          (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
Lua.pushnil (forall e. Pusher e Text
Lua.pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaItem -> Text
MB.mediaMimeType))
          TypeSpec
"string"
          Text
"The entry's MIME type, or nil if the file was not found."
      , forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult
          (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
Lua.pushnil (forall e. Pusher e ByteString
Lua.pushLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaItem -> ByteString
MB.mediaContents))
          TypeSpec
"string"
          Text
"Contents of the file, or nil if the file was not found."
      ]
  #? T.unlines
  [ "Lookup a media item in the media bag, and return its MIME type"
  , "and contents."
  , ""
  , "Usage:"
  , ""
  , "    local filename = 'media/diagram.png'"
  , "    local mt, contents = pandoc.mediabag.lookup(filename)"
  ]

-- | 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 -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (String, Text, Int) -> LuaE PandocError ()
pushEntry) TypeSpec
"table"
        (Text
"A list of elements summarizing each entry in the media\n" forall a. Semigroup a => a -> a -> a
<>
         Text
"bag. The summary item contains the keys `path`, `type`, and\n" forall a. Semigroup a => a -> a -> a
<>
         Text
"`length`, giving the filepath, MIME type, and length of\n" forall a. Semigroup a => a -> a -> a
<>
         Text
"contents in bytes, respectively.")
  #? T.unlines
  [ "Get a summary of the current media bag contents."
  , ""
  , "Usage:"
  , ""
  , "    -- calculate the size of the media bag."
  , "    local mb_items = pandoc.mediabag.list()"
  , "    local sum = 0"
  , "    for i = 1, #mb_items do"
  , "        sum = sum + mb_items[i].length"
  , "    end"
  , "    print(sum)"
  ]
 where
  pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError ()
  pushEntry :: (String, Text, Int) -> LuaE PandocError ()
pushEntry (String
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. String -> LuaE e ()
Lua.pushString String
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"
  ### (unPandocLua . fetchItem)
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"source" Text
"path to a resource; either a local file path or URI"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> ( forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall e. Pusher e Text
Lua.pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) TypeSpec
"string"
        Text
"The entry's MIME type, or `nil` if the file was not found."
        forall a. Semigroup a => a -> a -> a
<>
        forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall e. Pusher e ByteString
Lua.pushByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) TypeSpec
"string"
        Text
"Contents of the file, or `nil` if the file was not found."
      )
  #? T.unlines
  [ "Fetches the given source from a URL or local file. Returns two"
  , "values: the contents of the file and the MIME type (or an empty"
  , "string)."
  , ""
  , "The function will first try to retrieve `source` from the"
  , "mediabag; if that fails, it will try to download it or read it"
  , "from the local file system while respecting pandoc's \"resource"
  , "path\" setting."
  , ""
  , "Usage:"
  , ""
  , "    local diagram_url = 'https://pandoc.org/diagram.jpg'"
  , "    local mt, contents = pandoc.mediabag.fetch(diagram_url)"
  ]

-- | Extract the mediabag or just a single entry.
write :: DocumentedFunction PandocError
write :: DocumentedFunction PandocError
write = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"write"
  ### (\dir mfp -> do
          mb <- unPandocLua getMediaBag
          case mfp of
            Nothing -> unPandocLua $ mapM_ (writeMedia dir) (MB.mediaItems mb)
            Just fp -> do
              case MB.lookupMedia fp mb of
                Nothing   -> Lua.failLua ("Resource not in mediabag: " <> fp)
                Just item -> unPandocLua $ do
                  let triple = ( MB.mediaPath item
                               , MB.mediaMimeType item
                               , MB.mediaContents item
                               )
                  writeMedia dir triple)
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e String
stringParam Text
"dir" Text
"path of the target directory"
  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 String
stringParam Text
"fp" Text
"canonical name (relative path) of resource")
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
  #? T.unlines
     [ "Writes the contents of  mediabag to the given target directory. If"
     , "`fp` is given, then only the resource with the given name will be"
     , "extracted. Omitting that parameter means that the whole mediabag"
     , "gets extracted. An error is thrown if `fp` is given but cannot be"
     , "found in the mediabag."
     ]
  forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
0]