{- |
Copyright               : © 2021-2022 Albert Krewinkel
SPDX-License-Identifier : MIT
Maintainer              : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Marshaling/unmarshaling functions of 'CitationMode' values.
-}
module Text.Pandoc.Lua.Marshal.CitationMode
  ( peekCitationMode
  , pushCitationMode
  ) where

import HsLua
import Text.Pandoc.Definition (CitationMode)

-- | Retrieves a Citation value from a string.
peekCitationMode :: Peeker e CitationMode
peekCitationMode :: Peeker e CitationMode
peekCitationMode = Peeker e CitationMode
forall a e. Read a => Peeker e a
peekRead
{-# INLINE peekCitationMode #-}

-- | Pushes a CitationMode value as string.
pushCitationMode :: Pusher e CitationMode
pushCitationMode :: Pusher e CitationMode
pushCitationMode = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> (CitationMode -> String) -> Pusher e CitationMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CitationMode -> String
forall a. Show a => a -> String
show
{-# INLINE pushCitationMode #-}