{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Text.Pandoc.Lua.Module.Image
Copyright   : © 2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>

Lua module for basic image operations.
-}
module Text.Pandoc.Lua.Module.Image (
  -- * Module
    documentedModule

  -- ** Functions
  , size
  , format
  )
where

import Prelude hiding (null)
import Data.Default (Default (def))
import Data.Maybe (fromMaybe)
import Data.Version (makeVersion)
import HsLua.Core
import HsLua.Marshalling
import HsLua.Packaging
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.ImageSize (imageType, imageSize)
import Text.Pandoc.Lua.PandocLua ()
import Text.Pandoc.Lua.Marshal.ImageSize (pushImageType, pushImageSize)
import Text.Pandoc.Lua.Marshal.WriterOptions (peekWriterOptions)

import qualified Data.Text as T

-- | The @pandoc.image@ module specification.
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"pandoc.image"
  , moduleDescription :: Text
moduleDescription = Text
"Basic image querying functions."
  , moduleFields :: [Field PandocError]
moduleFields = [Field PandocError]
forall e. LuaError e => [Field e]
fields
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions = [DocumentedFunction PandocError]
functions
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  , moduleTypeInitializers :: [LuaE PandocError Name]
moduleTypeInitializers = []
  }

--
-- Fields
--

-- | Exported fields.
fields :: LuaError e => [Field e]
fields :: forall e. LuaError e => [Field e]
fields = []

--
-- Functions
--

functions :: [DocumentedFunction PandocError]
functions :: [DocumentedFunction PandocError]
functions =
  [ DocumentedFunction PandocError
size DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
1, Int
13]
  , DocumentedFunction PandocError
forall e. LuaError e => DocumentedFunction e
format DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
1, Int
13]
  ]

-- | Find the size of an image.
size :: DocumentedFunction PandocError
size :: DocumentedFunction PandocError
size = Name
-> (ByteString
    -> Maybe WriterOptions -> LuaE PandocError (Either Text ImageSize))
-> HsFnPrecursor
     PandocError
     (ByteString
      -> Maybe WriterOptions -> LuaE PandocError (Either Text ImageSize))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"size"
  ### liftPure2 (\img mwriterOpts -> imageSize (fromMaybe def mwriterOpts) img)
  HsFnPrecursor
  PandocError
  (ByteString
   -> Maybe WriterOptions -> LuaE PandocError (Either Text ImageSize))
-> Parameter PandocError ByteString
-> HsFnPrecursor
     PandocError
     (Maybe WriterOptions -> LuaE PandocError (Either Text ImageSize))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError ByteString
-> TypeSpec -> Text -> Text -> Parameter PandocError ByteString
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError ByteString
forall e. Peeker e ByteString
peekByteString TypeSpec
"string" Text
"image" Text
"image data"
  HsFnPrecursor
  PandocError
  (Maybe WriterOptions -> LuaE PandocError (Either Text ImageSize))
-> Parameter PandocError (Maybe WriterOptions)
-> HsFnPrecursor
     PandocError (LuaE PandocError (Either Text ImageSize))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter PandocError WriterOptions
-> Parameter PandocError (Maybe WriterOptions)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker PandocError WriterOptions
-> TypeSpec -> Text -> Text -> Parameter PandocError WriterOptions
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError WriterOptions
peekWriterOptions TypeSpec
"WriterOptions|table" Text
"opts"
           Text
"writer options")
  HsFnPrecursor
  PandocError (LuaE PandocError (Either Text ImageSize))
-> FunctionResults PandocError (Either Text ImageSize)
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError (Either Text ImageSize)
-> TypeSpec
-> Text
-> FunctionResults PandocError (Either Text ImageSize)
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult ((Text -> LuaE PandocError ())
-> (ImageSize -> LuaE PandocError ())
-> Pusher PandocError (Either Text ImageSize)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> LuaE PandocError ()
forall e a. LuaError e => String -> LuaE e a
failLua (String -> LuaE PandocError ())
-> (Text -> String) -> Text -> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ImageSize -> LuaE PandocError ()
forall e. LuaError e => Pusher e ImageSize
pushImageSize) TypeSpec
"table"
        Text
"image size information or error message"
  #? T.unlines
     [ "Returns a table containing the size and resolution of an image;"
     , "throws an error if the given string is not an image, or if the size"
     , "of the image cannot be determined."
     , ""
     , "The resulting table has four entries: *width*, *height*, *dpi\\_horz*,"
     , "and *dpi\\_vert*."
     , ""
     , "The `opts` parameter, when given, should be either a WriterOptions"
     , "object such as `PANDOC_WRITER_OPTIONS`, or a table with a `dpi` entry."
     , "It affects the calculation for vector image formats such as SVG."
     ]

-- | Returns the format of an image.
format :: LuaError e => DocumentedFunction e
format :: forall e. LuaError e => DocumentedFunction e
format = Name
-> (ByteString -> LuaE e (Maybe ImageType))
-> HsFnPrecursor e (ByteString -> LuaE e (Maybe ImageType))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"format"
  ### liftPure imageType
  HsFnPrecursor e (ByteString -> LuaE e (Maybe ImageType))
-> Parameter e ByteString
-> HsFnPrecursor e (LuaE e (Maybe ImageType))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e ByteString
-> TypeSpec -> Text -> Text -> Parameter e ByteString
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e ByteString
forall e. Peeker e ByteString
peekByteString TypeSpec
"string" Text
"image" Text
"binary image data"
  HsFnPrecursor e (LuaE e (Maybe ImageType))
-> FunctionResults e (Maybe ImageType) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e (Maybe ImageType)
-> TypeSpec -> Text -> FunctionResults e (Maybe ImageType)
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (LuaE e () -> (ImageType -> LuaE e ()) -> Pusher e (Maybe ImageType)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil ImageType -> LuaE e ()
forall e. LuaError e => Pusher e ImageType
pushImageType) TypeSpec
"string|nil"
        Text
"image format, or nil if the format cannot be determined"
  #? T.unlines
     [ "Returns the format of an image as a lowercase string."
     , ""
     , "Formats recognized by pandoc include *png*, *gif*, *tiff*, *jpeg*,"
     , "*pdf*, *svg*, *eps*, and *emf*."
     ]