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

Marshaling/unmarshaling functions and constructor for 'Citation' values.
-}
module Text.Pandoc.Lua.Marshal.Citation
  ( -- * Citation
    peekCitation
  , pushCitation
  , typeCitation
  , mkCitation
  ) where

import Control.Applicative (optional)
import Data.Aeson (encode)
import Data.Maybe (fromMaybe)
import HsLua as Lua
import Text.Pandoc.Definition (Citation (..))
import Text.Pandoc.Lua.Marshal.CitationMode (peekCitationMode, pushCitationMode)
import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline
  ( peekInlinesFuzzy, pushInlines )

-- | Pushes a Citation value as userdata object.
pushCitation :: LuaError e
             => Pusher e Citation
pushCitation :: forall e. LuaError e => Pusher e Citation
pushCitation = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e Citation
typeCitation
{-# INLINE pushCitation #-}

-- | Retrieves a Citation value.
peekCitation :: LuaError e
             => Peeker e Citation
peekCitation :: forall e. LuaError e => Peeker e Citation
peekCitation = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD  forall e. LuaError e => DocumentedType e Citation
typeCitation
{-# INLINE peekCitation #-}

-- | Citation object type.
typeCitation :: LuaError e
             => DocumentedType e Citation
typeCitation :: forall e. LuaError e => DocumentedType e Citation
typeCitation = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Citation"
  [ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
    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 (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Citation
peekCitation) TypeSpec
"Citation" Text
"a" Text
""
    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 (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Citation
peekCitation) TypeSpec
"Citation" Text
"b" Text
""
    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 Bool
pushBool TypeSpec
"boolean" Text
"true iff the citations are equal"

  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    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 Citation
peekCitation TypeSpec
"Citation" Text
"citation" Text
""
    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. String -> LuaE e ()
pushString TypeSpec
"string" Text
"native Haskell representation"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation (Name -> Operation
CustomOperation Name
"__tojson") forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure encode
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e Citation
typeCitation Text
"self" Text
""
    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 ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
  ]
  [ 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
"id" Text
"citation ID / key"
      (forall e. Pusher e Text
pushText, Citation -> Text
citationId)
      (forall e. Peeker e Text
peekText, \Citation
citation Text
cid -> Citation
citation{ citationId :: Text
citationId = Text
cid })
  , 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
"mode" Text
"citation mode"
      (forall e. Pusher e CitationMode
pushCitationMode, Citation -> CitationMode
citationMode)
      (forall e. Peeker e CitationMode
peekCitationMode, \Citation
citation CitationMode
mode -> Citation
citation{ citationMode :: CitationMode
citationMode = CitationMode
mode })
  , 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
"prefix" Text
"citation prefix"
      (forall e. LuaError e => Pusher e [Inline]
pushInlines, Citation -> [Inline]
citationPrefix)
      (forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy, \Citation
citation [Inline]
prefix -> Citation
citation{ citationPrefix :: [Inline]
citationPrefix = [Inline]
prefix })
  , 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
"suffix" Text
"citation suffix"
      (forall e. LuaError e => Pusher e [Inline]
pushInlines, Citation -> [Inline]
citationSuffix)
      (forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy, \Citation
citation [Inline]
suffix -> Citation
citation{ citationSuffix :: [Inline]
citationSuffix = [Inline]
suffix })
  , 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
"note_num" Text
"note number"
      (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, Citation -> Int
citationNoteNum)
      (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \Citation
citation Int
noteNum -> Citation
citation{ citationNoteNum :: Int
citationNoteNum = Int
noteNum })
  , 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
"hash" Text
"hash number"
      (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, Citation -> Int
citationHash)
      (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \Citation
citation Int
hash -> Citation
citation{ citationHash :: Int
citationHash = Int
hash })
  , forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
    ### return
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e Citation
typeCitation Text
"obj" Text
""
    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 Citation
pushCitation TypeSpec
"Citation" Text
"copy of obj"
  ]
{-# INLINABLE typeCitation #-}

-- | Constructor function for 'Citation' elements.
mkCitation :: LuaError e => DocumentedFunction e
mkCitation :: forall e. LuaError e => DocumentedFunction e
mkCitation = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Citation"
  ### (\cid mode mprefix msuffix mnote_num mhash ->
         cid `seq` mode `seq` mprefix `seq` msuffix `seq`
         mnote_num `seq` mhash `seq` return $! Citation
           { citationId = cid
           , citationMode = mode
           , citationPrefix = fromMaybe mempty mprefix
           , citationSuffix = fromMaybe mempty msuffix
           , citationNoteNum = fromMaybe 0 mnote_num
           , citationHash = fromMaybe 0 mhash
           })
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"cid" Text
"citation ID (e.g. bibtex key)"
  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 CitationMode
peekCitationMode TypeSpec
"CitationMode" Text
"mode" Text
"citation rendering mode"
  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 a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"prefix" Text
"Inlines" Text
"")
  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 a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"suffix" Text
"Inlines" Text
"")
  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 a e. (Read a, Integral a) => Text -> Text -> Parameter e a
integralParam Text
"note_num" Text
"note number")
  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 a e. (Read a, Integral a) => Text -> Text -> Parameter e a
integralParam Text
"hash"     Text
"hash number")
  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 Citation
pushCitation TypeSpec
"Citation" Text
"new citation object"
  #? "Creates a single citation."