{-# LANGUAGE OverloadedStrings    #-}
{- |
Copyright               : © 2021-2024 Albert Krewinkel
SPDX-License-Identifier : MIT
Maintainer              : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Marshaling and unmarshaling of 'Caption' elements.
-}
module Text.Pandoc.Lua.Marshal.Caption
  ( peekCaption
  , peekCaptionFuzzy
  , pushCaption
    -- * Constructor
  , mkCaption
  ) where

import Control.Applicative ((<|>), optional)
import Control.Monad ((<$!>))
import Data.Aeson (encode)
import Data.Maybe (fromMaybe)
import HsLua
import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block
  ( peekBlocksFuzzy, pushBlocks )
import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline
  ( peekInlinesFuzzy, pushInlines )
import Text.Pandoc.Definition

-- | Caption object type.
typeCaption :: LuaError e => DocumentedType e Caption
typeCaption :: forall e. LuaError e => DocumentedType e Caption
typeCaption = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Caption]
-> DocumentedType e Caption
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Caption"
  [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Maybe Caption -> Maybe Caption -> LuaE e Bool)
-> HsFnPrecursor e (Maybe Caption -> Maybe Caption -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
    HsFnPrecursor e (Maybe Caption -> Maybe Caption -> LuaE e Bool)
-> Parameter e (Maybe Caption)
-> HsFnPrecursor e (Maybe Caption -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Caption)
-> TypeSpec -> Text -> Text -> Parameter e (Maybe Caption)
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e Caption -> Peek e (Maybe Caption)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Caption -> Peek e (Maybe Caption))
-> (StackIndex -> Peek e Caption) -> Peeker e (Maybe Caption)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Caption
forall e. LuaError e => Peeker e Caption
peekCaption) TypeSpec
"Caption" Text
"a" Text
""
    HsFnPrecursor e (Maybe Caption -> LuaE e Bool)
-> Parameter e (Maybe Caption) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Caption)
-> TypeSpec -> Text -> Text -> Parameter e (Maybe Caption)
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e Caption -> Peek e (Maybe Caption)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Caption -> Peek e (Maybe Caption))
-> (StackIndex -> Peek e Caption) -> Peeker e (Maybe Caption)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Caption
forall e. LuaError e => Peeker e Caption
peekCaption) TypeSpec
"Caption" Text
"b" Text
""
    HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Bool -> TypeSpec -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool TypeSpec
"boolean" Text
"whether the two are equal"
  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Caption -> LuaE e String)
-> HsFnPrecursor e (Caption -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    HsFnPrecursor e (Caption -> LuaE e String)
-> Parameter e Caption -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e Caption -> Text -> Text -> Parameter e Caption
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e Caption
forall e. LuaError e => DocumentedType e Caption
typeCaption Text
"x" Text
""
    HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"native Haskell representation"
  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation (Name -> Operation
CustomOperation Name
"__tojson") (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Caption -> LuaE e ByteString)
-> HsFnPrecursor e (Caption -> LuaE e ByteString)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure encode
    HsFnPrecursor e (Caption -> LuaE e ByteString)
-> Parameter e Caption -> HsFnPrecursor e (LuaE e ByteString)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e Caption -> Text -> Text -> Parameter e Caption
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e Caption
forall e. LuaError e => DocumentedType e Caption
typeCaption Text
"self" Text
""
    HsFnPrecursor e (LuaE e ByteString)
-> FunctionResults e ByteString -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e ByteString
-> TypeSpec -> Text -> FunctionResults e ByteString
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e ByteString
forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
  ]
  [ Name
-> TypeSpec
-> Text
-> (Pusher e (Maybe [Inline]), Caption -> Maybe [Inline])
-> (Peeker e (Maybe [Inline]),
    Caption -> Maybe [Inline] -> Caption)
-> Member e (DocumentedFunction e) Caption
forall e b a fn.
LuaError e =>
Name
-> TypeSpec
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property' Name
"short"
    TypeSpec
"Inlines|nil"
    Text
"short caption used to describe the object"
      (LuaE e () -> ([Inline] -> LuaE e ()) -> Pusher e (Maybe [Inline])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil [Inline] -> LuaE e ()
forall e. LuaError e => Pusher e [Inline]
pushInlines, \(Caption Maybe [Inline]
short [Block]
_) -> Maybe [Inline]
short)
      (Peeker e [Inline] -> Peeker e (Maybe [Inline])
forall (m :: * -> *) e a.
Alternative m =>
Peeker e a -> Peeker e (m a)
peekNilOr Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy, \(Caption Maybe [Inline]
_ [Block]
long) Maybe [Inline]
shrt -> Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
shrt [Block]
long)
  , Name
-> Text
-> (Pusher e [Block], Caption -> [Block])
-> (Peeker e [Block], Caption -> [Block] -> Caption)
-> Member e (DocumentedFunction e) Caption
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"long" Text
"full caption text"
      (Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks, \(Caption Maybe [Inline]
_ [Block]
long) -> [Block]
long)
      (Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy, \(Caption Maybe [Inline]
short [Block]
_) [Block]
long -> Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
short [Block]
long)
  , DocumentedFunction e -> Member e (DocumentedFunction e) Caption
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Caption)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Caption
forall a b. (a -> b) -> a -> b
$ Name
-> (Caption -> LuaE e Caption)
-> HsFnPrecursor e (Caption -> LuaE e Caption)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
    ### return
    HsFnPrecursor e (Caption -> LuaE e Caption)
-> Parameter e Caption -> HsFnPrecursor e (LuaE e Caption)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e Caption)
-> TypeSpec -> Text -> Text -> Parameter e Caption
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Caption
forall e. LuaError e => Peeker e Caption
peekCaption TypeSpec
"Caption" Text
"capt" Text
""
    HsFnPrecursor e (LuaE e Caption)
-> FunctionResults e Caption -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Caption -> TypeSpec -> Text -> FunctionResults e Caption
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Caption
forall e. LuaError e => Pusher e Caption
pushCaption TypeSpec
"Caption" Text
"cloned Caption element"
  ]

-- | Push Caption element
pushCaption :: LuaError e => Pusher e Caption
pushCaption :: forall e. LuaError e => Pusher e Caption
pushCaption = DocumentedTypeWithList e Caption Void -> Caption -> LuaE e ()
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList e Caption Void
forall e. LuaError e => DocumentedType e Caption
typeCaption

-- | Peek Caption element from userdata.
peekCaption :: LuaError e => Peeker e Caption
peekCaption :: forall e. LuaError e => Peeker e Caption
peekCaption = DocumentedTypeWithList e Caption Void -> Peeker e Caption
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD DocumentedTypeWithList e Caption Void
forall e. LuaError e => DocumentedType e Caption
typeCaption

-- | Peek Caption element from a table.
peekCaptionTable :: LuaError e => Peeker e Caption
peekCaptionTable :: forall e. LuaError e => Peeker e Caption
peekCaptionTable StackIndex
idx = do
  short <- Peek e [Inline] -> Peek e (Maybe [Inline])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e [Inline] -> Peek e (Maybe [Inline]))
-> Peek e [Inline] -> Peek e (Maybe [Inline])
forall a b. (a -> b) -> a -> b
$ Peeker e [Inline] -> Name -> Peeker e [Inline]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Name
"short" StackIndex
idx
  long <- peekFieldRaw peekBlocksFuzzy "long" idx
  return $! Caption short long

peekCaptionFuzzy :: LuaError e => Peeker e Caption
peekCaptionFuzzy :: forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy = Name -> Peek e Caption -> Peek e Caption
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Caption" (Peek e Caption -> Peek e Caption)
-> (StackIndex -> Peek e Caption) -> StackIndex -> Peek e Caption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> do
      StackIndex -> Peek e Caption
forall e. LuaError e => Peeker e Caption
peekCaption StackIndex
idx
  Peek e Caption -> Peek e Caption -> Peek e Caption
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StackIndex -> Peek e Caption
forall e. LuaError e => Peeker e Caption
peekCaptionTable StackIndex
idx
  Peek e Caption -> Peek e Caption -> Peek e Caption
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing ([Block] -> Caption) -> Peek e [Block] -> Peek e Caption
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx)
  Peek e Caption -> Peek e Caption -> Peek e Caption
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Peek e Caption
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e Caption)
-> Peek e ByteString -> Peek e Caption
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
       Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Caption, list of Blocks, or compatible element" StackIndex
idx)

-- | Constructor for 'Caption'.
mkCaption :: LuaError e => DocumentedFunction e
mkCaption :: forall e. LuaError e => DocumentedFunction e
mkCaption = Name
-> (Maybe [Block] -> Maybe [Inline] -> LuaE e Caption)
-> HsFnPrecursor
     e (Maybe [Block] -> Maybe [Inline] -> LuaE e Caption)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Caption"
  ### (\mLong short ->
         let long = fromMaybe mempty mLong
         in pure (Caption short long))
  HsFnPrecursor e (Maybe [Block] -> Maybe [Inline] -> LuaE e Caption)
-> Parameter e (Maybe [Block])
-> HsFnPrecursor e (Maybe [Inline] -> LuaE e Caption)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Block] -> Parameter e (Maybe [Block])
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"long" Text
"full caption")
  HsFnPrecursor e (Maybe [Inline] -> LuaE e Caption)
-> Parameter e (Maybe [Inline]) -> HsFnPrecursor e (LuaE e Caption)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Inline] -> Parameter e (Maybe [Inline])
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e [Inline]
-> TypeSpec -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"short" Text
"short summary caption")
  HsFnPrecursor e (LuaE e Caption)
-> FunctionResults e Caption -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Caption -> TypeSpec -> Text -> FunctionResults e Caption
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Caption
forall e. LuaError e => Pusher e Caption
pushCaption TypeSpec
"Caption" Text
"new Caption object"
  #? "Creates a new Caption object."