{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TupleSections        #-}
{-# LANGUAGE TypeApplications     #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.AST
   Copyright   : © 2012-2021 John MacFarlane
                 © 2017-2021 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Marshaling/unmarshaling instances for document AST elements.
-}
module Text.Pandoc.Lua.Marshaling.AST
  ( peekAttr
  , peekBlock
  , peekBlockFuzzy
  , peekBlocks
  , peekBlocksFuzzy
  , peekCaption
  , peekCitation
  , peekColSpec
  , peekDefinitionItem
  , peekFormat
  , peekInline
  , peekInlineFuzzy
  , peekInlines
  , peekInlinesFuzzy
  , peekMeta
  , peekMetaValue
  , peekPandoc
  , peekMathType
  , peekQuoteType
  , peekTableBody
  , peekTableHead
  , peekTableFoot

  , pushAttr
  , pushBlock
  , pushCitation
  , pushInline
  , pushListAttributes
  , pushMeta
  , pushMetaValue
  , pushPandoc
  ) where

import Control.Applicative ((<|>), optional)
import Control.Monad.Catch (throwM)
import Control.Monad ((<$!>))
import Data.Data (showConstr, toConstr)
import Data.Text (Text)
import Data.Version (Version)
import HsLua hiding (Operation (Div))
import HsLua.Module.Version (peekVersionFuzzy)
import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Util (pushViaConstr')
import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr)
import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
import Text.Pandoc.Lua.Marshaling.ListAttributes
  (peekListAttributes, pushListAttributes)

import qualified HsLua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil

instance Pushable Pandoc where
  push :: Pandoc -> LuaE e ()
push = Pandoc -> LuaE e ()
forall e. LuaError e => Pandoc -> LuaE e ()
pushPandoc

pushPandoc :: LuaError e => Pusher e Pandoc
pushPandoc :: Pusher e Pandoc
pushPandoc = UDTypeWithList e (DocumentedFunction e) Pandoc Void
-> Pusher e Pandoc
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Pandoc Void
forall e. LuaError e => DocumentedType e Pandoc
typePandoc

peekPandoc :: LuaError e => Peeker e Pandoc
peekPandoc :: Peeker e Pandoc
peekPandoc = Name -> Peek e Pandoc -> Peek e Pandoc
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Pandoc value" (Peek e Pandoc -> Peek e Pandoc)
-> Peeker e Pandoc -> Peeker e Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UDTypeWithList e (DocumentedFunction e) Pandoc Void
-> Peeker e Pandoc
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) Pandoc Void
forall e. LuaError e => DocumentedType e Pandoc
typePandoc

typePandoc :: LuaError e => DocumentedType e Pandoc
typePandoc :: DocumentedType e Pandoc
typePandoc = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Pandoc]
-> DocumentedType e Pandoc
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Pandoc"
  [ 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
$ Name
-> (Maybe Pandoc -> Maybe Pandoc -> LuaE e Bool)
-> HsFnPrecursor e (Maybe Pandoc -> Maybe Pandoc -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__eq"
     ### liftPure2 (==)
     HsFnPrecursor e (Maybe Pandoc -> Maybe Pandoc -> LuaE e Bool)
-> Parameter e (Maybe Pandoc)
-> HsFnPrecursor e (Maybe Pandoc -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Pandoc)
-> Text -> Text -> Text -> Parameter e (Maybe Pandoc)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e Pandoc -> Peek e (Maybe Pandoc)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Pandoc -> Peek e (Maybe Pandoc))
-> (StackIndex -> Peek e Pandoc) -> Peeker e (Maybe Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc) Text
"doc1" Text
"pandoc" Text
""
     HsFnPrecursor e (Maybe Pandoc -> LuaE e Bool)
-> Parameter e (Maybe Pandoc) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Pandoc)
-> Text -> Text -> Text -> Parameter e (Maybe Pandoc)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e Pandoc -> Peek e (Maybe Pandoc)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Pandoc -> Peek e (Maybe Pandoc))
-> (StackIndex -> Peek e Pandoc) -> Peeker e (Maybe Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc) Text
"doc2" Text
"pandoc" 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 -> Text -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool Text
"boolean" Text
"true iff the two values 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
$ (Pandoc -> LuaE e String)
-> HsFnPrecursor e (Pandoc -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    HsFnPrecursor e (Pandoc -> LuaE e String)
-> Parameter e Pandoc -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e Pandoc)
-> Text -> Text -> Text -> Parameter e Pandoc
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"doc" 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 -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString Text
"string" Text
"native Haskell representation"
  ]
  [ Name
-> Text
-> (Pusher e [Block], Pandoc -> [Block])
-> (Peeker e [Block], Pandoc -> [Block] -> Pandoc)
-> Member e (DocumentedFunction e) Pandoc
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
"blocks" Text
"list of blocks"
      (Pusher e Block -> Pusher e [Block]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock, \(Pandoc Meta
_ [Block]
blks) -> [Block]
blks)
      (Peeker e Block -> Peeker e [Block]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock, \(Pandoc Meta
m [Block]
_) [Block]
blks -> Meta -> [Block] -> Pandoc
Pandoc Meta
m [Block]
blks)
  , Name
-> Text
-> (Pusher e Meta, Pandoc -> Meta)
-> (Peeker e Meta, Pandoc -> Meta -> Pandoc)
-> Member e (DocumentedFunction e) Pandoc
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
"meta" Text
"document metadata"
      (Pusher e Meta
forall e. LuaError e => Pusher e Meta
pushMeta, \(Pandoc Meta
meta [Block]
_) -> Meta
meta)
      (Peeker e Meta
forall e. LuaError e => Peeker e Meta
peekMeta, \(Pandoc Meta
_ [Block]
blks) Meta
meta -> Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blks)
  ]

instance Pushable Meta where
  push :: Meta -> LuaE e ()
push = Meta -> LuaE e ()
forall e. LuaError e => Pusher e Meta
pushMeta

pushMeta :: LuaError e => Pusher e Meta
pushMeta :: Pusher e Meta
pushMeta (Meta Map Text MetaValue
mmap) = Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"Meta" [Map Text MetaValue -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Map Text MetaValue
mmap]

peekMeta :: LuaError e => Peeker e Meta
peekMeta :: Peeker e Meta
peekMeta StackIndex
idx = Name -> Peek e Meta -> Peek e Meta
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Meta" (Peek e Meta -> Peek e Meta) -> Peek e Meta -> Peek e Meta
forall a b. (a -> b) -> a -> b
$
  Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta)
-> Peek e (Map Text MetaValue) -> Peek e Meta
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
-> Peeker e MetaValue -> Peeker e (Map Text MetaValue)
forall a e b.
Ord a =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e Text
forall e. Peeker e Text
peekText Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue StackIndex
idx

instance Pushable MetaValue where
  push :: MetaValue -> LuaE e ()
push = MetaValue -> LuaE e ()
forall e. LuaError e => MetaValue -> LuaE e ()
pushMetaValue

instance Pushable Block where
  push :: Block -> LuaE e ()
push = Block -> LuaE e ()
forall e. LuaError e => Block -> LuaE e ()
pushBlock

typeCitation :: LuaError e => DocumentedType e Citation
typeCitation :: DocumentedType e Citation
typeCitation = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Citation]
-> DocumentedType e Citation
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Citation"
  [ 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 Citation -> Maybe Citation -> LuaE e Bool)
-> HsFnPrecursor
     e (Maybe Citation -> Maybe Citation -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (==)
    HsFnPrecursor e (Maybe Citation -> Maybe Citation -> LuaE e Bool)
-> Parameter e (Maybe Citation)
-> HsFnPrecursor e (Maybe Citation -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Citation)
-> Text -> Text -> Text -> Parameter e (Maybe Citation)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e Citation -> Peek e (Maybe Citation)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Citation -> Peek e (Maybe Citation))
-> (StackIndex -> Peek e Citation) -> Peeker e (Maybe Citation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Citation
forall e. LuaError e => Peeker e Citation
peekCitation) Text
"Citation" Text
"a" Text
""
    HsFnPrecursor e (Maybe Citation -> LuaE e Bool)
-> Parameter e (Maybe Citation) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Citation)
-> Text -> Text -> Text -> Parameter e (Maybe Citation)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e Citation -> Peek e (Maybe Citation)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Citation -> Peek e (Maybe Citation))
-> (StackIndex -> Peek e Citation) -> Peeker e (Maybe Citation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Citation
forall e. LuaError e => Peeker e Citation
peekCitation) Text
"Citation" 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 -> Text -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool Text
"boolean" Text
"true iff the citations 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
$ (Citation -> LuaE e String)
-> HsFnPrecursor e (Citation -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    HsFnPrecursor e (Citation -> LuaE e String)
-> Parameter e Citation -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e Citation)
-> Text -> Text -> Text -> Parameter e Citation
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Citation
forall e. LuaError e => Peeker e Citation
peekCitation Text
"Citation" Text
"citation" 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 -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString Text
"string" Text
"native Haskell representation"
  ]
  [ Name
-> Text
-> (Pusher e Text, Citation -> Text)
-> (Peeker e Text, Citation -> Text -> Citation)
-> Member e (DocumentedFunction e) Citation
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"
      (Pusher e Text
forall e. Pusher e Text
pushText, Citation -> Text
citationId)
      (Peeker e Text
forall e. Peeker e Text
peekText, \Citation
citation Text
cid -> Citation
citation{ citationId :: Text
citationId = Text
cid })
  , Name
-> Text
-> (Pusher e CitationMode, Citation -> CitationMode)
-> (Peeker e CitationMode, Citation -> CitationMode -> Citation)
-> Member e (DocumentedFunction e) Citation
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"
      (Pusher e String
forall e. String -> LuaE e ()
pushString Pusher e String
-> (CitationMode -> String) -> Pusher e CitationMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CitationMode -> String
forall a. Show a => a -> String
show, Citation -> CitationMode
citationMode)
      (Peeker e CitationMode
forall a e. Read a => Peeker e a
peekRead, \Citation
citation CitationMode
mode -> Citation
citation{ citationMode :: CitationMode
citationMode = CitationMode
mode })
  , Name
-> Text
-> (Pusher e [Inline], Citation -> [Inline])
-> (Peeker e [Inline], Citation -> [Inline] -> Citation)
-> Member e (DocumentedFunction e) Citation
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"
      (Pusher e [Inline]
forall e. LuaError e => Pusher e [Inline]
pushInlines, Citation -> [Inline]
citationPrefix)
      (Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines, \Citation
citation [Inline]
prefix -> Citation
citation{ citationPrefix :: [Inline]
citationPrefix = [Inline]
prefix })
  , Name
-> Text
-> (Pusher e [Inline], Citation -> [Inline])
-> (Peeker e [Inline], Citation -> [Inline] -> Citation)
-> Member e (DocumentedFunction e) Citation
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"
      (Pusher e [Inline]
forall e. LuaError e => Pusher e [Inline]
pushInlines, Citation -> [Inline]
citationSuffix)
      (Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines, \Citation
citation [Inline]
suffix -> Citation
citation{ citationPrefix :: [Inline]
citationPrefix = [Inline]
suffix })
  , Name
-> Text
-> (Pusher e Int, Citation -> Int)
-> (Peeker e Int, Citation -> Int -> Citation)
-> Member e (DocumentedFunction e) Citation
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"
      (Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, Citation -> Int
citationNoteNum)
      (Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \Citation
citation Int
noteNum -> Citation
citation{ citationNoteNum :: Int
citationNoteNum = Int
noteNum })
  , Name
-> Text
-> (Pusher e Int, Citation -> Int)
-> (Peeker e Int, Citation -> Int -> Citation)
-> Member e (DocumentedFunction e) Citation
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"
      (Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, Citation -> Int
citationHash)
      (Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \Citation
citation Int
hash -> Citation
citation{ citationHash :: Int
citationHash = Int
hash })
  , DocumentedFunction e -> Member e (DocumentedFunction e) Citation
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Citation)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Citation
forall a b. (a -> b) -> a -> b
$ Name
-> (Citation -> LuaE e Citation)
-> HsFnPrecursor e (Citation -> LuaE e Citation)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone" ((Citation -> LuaE e Citation)
 -> HsFnPrecursor e (Citation -> LuaE e Citation))
-> (Citation -> LuaE e Citation)
-> HsFnPrecursor e (Citation -> LuaE e Citation)
forall a e. (a -> HsFnPrecursor e a) -> a -> HsFnPrecursor e a
### Citation -> LuaE e Citation
forall (m :: * -> *) a. Monad m => a -> m a
return HsFnPrecursor e (Citation -> LuaE e Citation)
-> Parameter e Citation -> HsFnPrecursor e (LuaE e Citation)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e Citation -> Text -> Text -> Parameter e Citation
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e Citation
forall e. LuaError e => DocumentedType e Citation
typeCitation Text
"obj" Text
""
    HsFnPrecursor e (LuaE e Citation)
-> FunctionResults e Citation -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Citation -> Text -> Text -> FunctionResults e Citation
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Citation
forall e. LuaError e => Pusher e Citation
pushCitation Text
"Citation" Text
"copy of obj"
  ]

pushCitation :: LuaError e => Pusher e Citation
pushCitation :: Pusher e Citation
pushCitation = UDTypeWithList e (DocumentedFunction e) Citation Void
-> Pusher e Citation
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Citation Void
forall e. LuaError e => DocumentedType e Citation
typeCitation

peekCitation :: LuaError e => Peeker e Citation
peekCitation :: Peeker e Citation
peekCitation = UDTypeWithList e (DocumentedFunction e) Citation Void
-> Peeker e Citation
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) Citation Void
forall e. LuaError e => DocumentedType e Citation
typeCitation

instance Pushable Alignment where
  push :: Alignment -> LuaE e ()
push = String -> LuaE e ()
forall e. String -> LuaE e ()
Lua.pushString (String -> LuaE e ())
-> (Alignment -> String) -> Alignment -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> String
forall a. Show a => a -> String
show

instance Pushable CitationMode where
  push :: CitationMode -> LuaE e ()
push = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ())
-> (CitationMode -> String) -> CitationMode -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CitationMode -> String
forall a. Show a => a -> String
show

instance Pushable Format where
  push :: Format -> LuaE e ()
push = Format -> LuaE e ()
forall e. LuaError e => Format -> LuaE e ()
pushFormat

pushFormat :: LuaError e => Pusher e Format
pushFormat :: Pusher e Format
pushFormat (Format Text
f) = Pusher e Text
forall e. Pusher e Text
pushText Text
f

peekFormat :: LuaError e => Peeker e Format
peekFormat :: Peeker e Format
peekFormat StackIndex
idx = Text -> Format
Format (Text -> Format) -> Peek e Text -> Peek e Format
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx

instance Pushable ListNumberDelim where
  push :: ListNumberDelim -> LuaE e ()
push = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ())
-> (ListNumberDelim -> String) -> ListNumberDelim -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberDelim -> String
forall a. Show a => a -> String
show

instance Pushable ListNumberStyle where
  push :: ListNumberStyle -> LuaE e ()
push = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ())
-> (ListNumberStyle -> String) -> ListNumberStyle -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberStyle -> String
forall a. Show a => a -> String
show

instance Pushable MathType where
  push :: MathType -> LuaE e ()
push = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ())
-> (MathType -> String) -> MathType -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> String
forall a. Show a => a -> String
show

instance Pushable QuoteType where
  push :: QuoteType -> LuaE e ()
push = QuoteType -> LuaE e ()
forall e. LuaError e => QuoteType -> LuaE e ()
pushQuoteType

pushMathType :: LuaError e => Pusher e MathType
pushMathType :: Pusher e MathType
pushMathType = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ()) -> (MathType -> String) -> Pusher e MathType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> String
forall a. Show a => a -> String
show

peekMathType :: LuaError e => Peeker e MathType
peekMathType :: Peeker e MathType
peekMathType = Peeker e MathType
forall a e. Read a => Peeker e a
peekRead

pushQuoteType :: LuaError e => Pusher e QuoteType
pushQuoteType :: Pusher e QuoteType
pushQuoteType = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> (QuoteType -> String) -> Pusher e QuoteType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteType -> String
forall a. Show a => a -> String
show

peekQuoteType :: LuaError e => Peeker e QuoteType
peekQuoteType :: Peeker e QuoteType
peekQuoteType = Peeker e QuoteType
forall a e. Read a => Peeker e a
peekRead

-- | Push an meta value element to the top of the lua stack.
pushMetaValue :: LuaError e => MetaValue -> LuaE e ()
pushMetaValue :: MetaValue -> LuaE e ()
pushMetaValue = \case
  MetaBlocks [Block]
blcks  -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"MetaBlocks" [Pusher e Block -> [Block] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushList Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock [Block]
blcks]
  MetaBool Bool
bool     -> Bool -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Bool
bool
  MetaInlines [Inline]
inlns -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"MetaInlines"
                       [Pusher e Inline -> [Inline] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushList Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline [Inline]
inlns]
  MetaList [MetaValue]
metalist -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"MetaList"
                       [(MetaValue -> LuaE e ()) -> [MetaValue] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushList MetaValue -> LuaE e ()
forall e. LuaError e => MetaValue -> LuaE e ()
pushMetaValue [MetaValue]
metalist]
  MetaMap Map Text MetaValue
metamap   -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"MetaMap"
                       [Pusher e Text
-> (MetaValue -> LuaE e ()) -> Pusher e (Map Text MetaValue)
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e (Map a b)
pushMap Pusher e Text
forall e. Pusher e Text
pushText MetaValue -> LuaE e ()
forall e. LuaError e => MetaValue -> LuaE e ()
pushMetaValue Map Text MetaValue
metamap]
  MetaString Text
str    -> Pusher e Text
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Text
str

-- | Interpret the value at the given stack index as meta value.
peekMetaValue :: forall e. LuaError e => Peeker e MetaValue
peekMetaValue :: Peeker e MetaValue
peekMetaValue = Name -> Peek e MetaValue -> Peek e MetaValue
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaValue $ " (Peek e MetaValue -> Peek e MetaValue)
-> Peeker e MetaValue -> Peeker e MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> do
  -- Get the contents of an AST element.
  let mkMV :: (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
      mkMV :: (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV a -> MetaValue
f Peeker e a
p = a -> MetaValue
f (a -> MetaValue) -> Peek e a -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e a
p StackIndex
idx

      peekTagged :: Name -> Peek e MetaValue
peekTagged = \case
        Name
"MetaBlocks"  -> ([Block] -> MetaValue) -> Peeker e [Block] -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV [Block] -> MetaValue
MetaBlocks (Peeker e [Block] -> Peek e MetaValue)
-> Peeker e [Block] -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
          Name -> Peek e [Block] -> Peek e [Block]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaBlocks" (Peek e [Block] -> Peek e [Block])
-> Peeker e [Block] -> Peeker e [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks
        Name
"MetaBool"    -> (Bool -> MetaValue) -> Peeker e Bool -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV Bool -> MetaValue
MetaBool (Peeker e Bool -> Peek e MetaValue)
-> Peeker e Bool -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
          Name -> Peek e Bool -> Peek e Bool
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaBool" (Peek e Bool -> Peek e Bool) -> Peeker e Bool -> Peeker e Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Bool
forall e. Peeker e Bool
peekBool
        Name
"MetaMap"     -> (Map Text MetaValue -> MetaValue)
-> Peeker e (Map Text MetaValue) -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV Map Text MetaValue -> MetaValue
MetaMap (Peeker e (Map Text MetaValue) -> Peek e MetaValue)
-> Peeker e (Map Text MetaValue) -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
          Name -> Peek e (Map Text MetaValue) -> Peek e (Map Text MetaValue)
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaMap" (Peek e (Map Text MetaValue) -> Peek e (Map Text MetaValue))
-> Peeker e (Map Text MetaValue) -> Peeker e (Map Text MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Text
-> Peeker e MetaValue -> Peeker e (Map Text MetaValue)
forall a e b.
Ord a =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e Text
forall e. Peeker e Text
peekText Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue
        Name
"MetaInlines" -> ([Inline] -> MetaValue) -> Peeker e [Inline] -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV [Inline] -> MetaValue
MetaInlines (Peeker e [Inline] -> Peek e MetaValue)
-> Peeker e [Inline] -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
          Name -> Peek e [Inline] -> Peek e [Inline]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaInlines" (Peek e [Inline] -> Peek e [Inline])
-> Peeker e [Inline] -> Peeker e [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines
        Name
"MetaList"    -> ([MetaValue] -> MetaValue)
-> Peeker e [MetaValue] -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV [MetaValue] -> MetaValue
MetaList (Peeker e [MetaValue] -> Peek e MetaValue)
-> Peeker e [MetaValue] -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
          Name -> Peek e [MetaValue] -> Peek e [MetaValue]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaList" (Peek e [MetaValue] -> Peek e [MetaValue])
-> Peeker e [MetaValue] -> Peeker e [MetaValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e MetaValue -> Peeker e [MetaValue]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue
        Name
"MetaString"  -> (Text -> MetaValue) -> Peeker e Text -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV Text -> MetaValue
MetaString (Peeker e Text -> Peek e MetaValue)
-> Peeker e Text -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
          Name -> Peek e Text -> Peek e Text
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaString" (Peek e Text -> Peek e Text) -> Peeker e Text -> Peeker e Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Text
forall e. Peeker e Text
peekText
        (Name ByteString
t)      -> ByteString -> Peek e MetaValue
forall a e. ByteString -> Peek e a
failPeek (ByteString
"Unknown meta tag: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t)

      peekUntagged :: Peek e MetaValue
peekUntagged = do
        -- no meta value tag given, try to guess.
        Int
len <- LuaE e Int -> Peek e Int
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Int -> Peek e Int) -> LuaE e Int -> Peek e Int
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Int
forall e. StackIndex -> LuaE e Int
Lua.rawlen StackIndex
idx
        if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
          then Map Text MetaValue -> MetaValue
MetaMap (Map Text MetaValue -> MetaValue)
-> Peek e (Map Text MetaValue) -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
-> Peeker e MetaValue -> Peeker e (Map Text MetaValue)
forall a e b.
Ord a =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e Text
forall e. Peeker e Text
peekText Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue StackIndex
idx
          else  ([Inline] -> MetaValue
MetaInlines ([Inline] -> MetaValue) -> Peek e [Inline] -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines StackIndex
idx)
            Peek e MetaValue -> Peek e MetaValue -> Peek e MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Block] -> MetaValue
MetaBlocks ([Block] -> MetaValue) -> Peek e [Block] -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks StackIndex
idx)
            Peek e MetaValue -> Peek e MetaValue -> Peek e MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([MetaValue] -> MetaValue
MetaList ([MetaValue] -> MetaValue)
-> Peek e [MetaValue] -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e MetaValue -> Peeker e [MetaValue]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue StackIndex
idx)
  Type
luatype <- LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Type -> Peek e Type) -> LuaE e Type -> Peek e Type
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx
  case Type
luatype of
    Type
Lua.TypeBoolean -> Bool -> MetaValue
MetaBool (Bool -> MetaValue) -> Peek e Bool -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Bool
forall e. Peeker e Bool
peekBool StackIndex
idx
    Type
Lua.TypeString  -> Text -> MetaValue
MetaString (Text -> MetaValue) -> Peek e Text -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
    Type
Lua.TypeTable   -> do
      Peek e Name -> Peek e (Maybe Name)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e Name
forall e. LuaError e => Peeker e Name
LuaUtil.getTag StackIndex
idx) Peek e (Maybe Name)
-> (Maybe Name -> Peek e MetaValue) -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Name
tag -> Name -> Peek e MetaValue
peekTagged Name
tag
        Maybe Name
Nothing  -> Peek e MetaValue
peekUntagged
    Type
_        -> ByteString -> Peek e MetaValue
forall a e. ByteString -> Peek e a
failPeek ByteString
"could not get meta value"

typeBlock :: LuaError e => DocumentedType e Block
typeBlock :: DocumentedType e Block
typeBlock = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Block]
-> DocumentedType e Block
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Block"
  [ 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
$ (Block -> Block -> LuaE e Bool)
-> HsFnPrecursor e (Block -> Block -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (==)
    HsFnPrecursor e (Block -> Block -> LuaE e Bool)
-> Parameter e Block -> HsFnPrecursor e (Block -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Block -> Text -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlockFuzzy Text
"Block" Text
"a" Text
""
    HsFnPrecursor e (Block -> LuaE e Bool)
-> Parameter e Block -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Block -> Text -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlockFuzzy Text
"Block" 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
=#> Text -> FunctionResults e Bool
forall e. Text -> FunctionResults e Bool
boolResult Text
"whether the two values 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
$ (Block -> LuaE e String)
-> HsFnPrecursor e (Block -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    HsFnPrecursor e (Block -> LuaE e String)
-> Parameter e Block -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e Block -> Text -> Text -> Parameter e Block
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e Block
forall e. LuaError e => DocumentedType e Block
typeBlock Text
"self" 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 -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString Text
"string" Text
"Haskell representation"
  ]
  [ Name
-> Text
-> (Pusher e Attr, Block -> Possible Attr)
-> (Peeker e Attr, Block -> Attr -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"attr" Text
"element attributes"
      (Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr, \case
          CodeBlock Attr
attr Text
_     -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
          Div Attr
attr [Block]
_           -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
          Header Int
_ Attr
attr [Inline]
_      -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
          Table Attr
attr Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
          Block
_                    -> Possible Attr
forall a. Possible a
Absent)
      (Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr, \case
          CodeBlock Attr
_ Text
code     -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Attr -> Block) -> Attr -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Text -> Block) -> Text -> Attr -> Block
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Text -> Block
CodeBlock Text
code
          Div Attr
_ [Block]
blks           -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Attr -> Block) -> Attr -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> [Block] -> Block) -> [Block] -> Attr -> Block
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> [Block] -> Block
Div [Block]
blks
          Header Int
lvl Attr
_ [Inline]
blks    -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Attr -> Block) -> Attr -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Attr
attr -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr [Inline]
blks)
          Table Attr
_ Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f  -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Attr -> Block) -> Attr -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Attr
attr -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
          Block
_                    -> Possible Block -> Attr -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e [TableBody], Block -> Possible [TableBody])
-> (Peeker e [TableBody], Block -> [TableBody] -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"bodies" Text
"table bodies"
      (Pusher e TableBody -> Pusher e [TableBody]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e TableBody
forall e. LuaError e => Pusher e TableBody
pushTableBody, \case
          Table Attr
_ Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
bs TableFoot
_ -> [TableBody] -> Possible [TableBody]
forall a. a -> Possible a
Actual [TableBody]
bs
          Block
_                  -> Possible [TableBody]
forall a. Possible a
Absent)
      (Peeker e TableBody -> Peeker e [TableBody]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e TableBody
forall e. LuaError e => Peeker e TableBody
peekTableBody, \case
          Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
_ TableFoot
f -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> ([TableBody] -> Block) -> [TableBody] -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[TableBody]
bs -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
          Block
_                     -> Possible Block -> [TableBody] -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e Caption, Block -> Possible Caption)
-> (Peeker e Caption, Block -> Caption -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"caption" Text
"element caption"
      (Pusher e Caption
forall e. LuaError e => Caption -> LuaE e ()
pushCaption, \case {Table Attr
_ Caption
capt [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_ -> Caption -> Possible Caption
forall a. a -> Possible a
Actual Caption
capt; Block
_ -> Possible Caption
forall a. Possible a
Absent})
      (Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaption, \case
          Table Attr
attr Caption
_ [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Caption -> Block) -> Caption -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Caption
c -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
          Block
_                      -> Possible Block -> Caption -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e [ColSpec], Block -> Possible [ColSpec])
-> (Peeker e [ColSpec], Block -> [ColSpec] -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"colspecs" Text
"column alignments and widths"
      (Pusher e ColSpec -> Pusher e [ColSpec]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e ColSpec
forall e. LuaError e => Pusher e ColSpec
pushColSpec, \case
          Table Attr
_ Caption
_ [ColSpec]
cs TableHead
_ [TableBody]
_ TableFoot
_     -> [ColSpec] -> Possible [ColSpec]
forall a. a -> Possible a
Actual [ColSpec]
cs
          Block
_                      -> Possible [ColSpec]
forall a. Possible a
Absent)
      (Peeker e ColSpec -> Peeker e [ColSpec]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ColSpec
forall e. LuaError e => Peeker e ColSpec
peekColSpec, \case
          Table Attr
attr Caption
c [ColSpec]
_ TableHead
h [TableBody]
bs TableFoot
f  -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> ([ColSpec] -> Block) -> [ColSpec] -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[ColSpec]
cs -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
          Block
_                      -> Possible Block -> [ColSpec] -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e Content, Block -> Possible Content)
-> (Peeker e Content, Block -> Content -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"content" Text
"element content"
      (Pusher e Content
forall e. LuaError e => Pusher e Content
pushContent, Block -> Possible Content
getBlockContent)
      (Peeker e Content
forall e. LuaError e => Peeker e Content
peekContent, Block -> Content -> Possible Block
setBlockContent)
  , Name
-> Text
-> (Pusher e TableFoot, Block -> Possible TableFoot)
-> (Peeker e TableFoot, Block -> TableFoot -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"foot" Text
"table foot"
      (Pusher e TableFoot
forall e. LuaError e => Pusher e TableFoot
pushTableFoot, \case {Table Attr
_ Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
f -> TableFoot -> Possible TableFoot
forall a. a -> Possible a
Actual TableFoot
f; Block
_ -> Possible TableFoot
forall a. Possible a
Absent})
      (Peeker e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot, \case
          Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (TableFoot -> Block) -> TableFoot -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\TableFoot
f -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
          Block
_                      -> Possible Block -> TableFoot -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e Format, Block -> Possible Format)
-> (Peeker e Format, Block -> Format -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"format" Text
"format of raw content"
      (Pusher e Format
forall e. LuaError e => Format -> LuaE e ()
pushFormat, \case {RawBlock Format
f Text
_ -> Format -> Possible Format
forall a. a -> Possible a
Actual Format
f; Block
_ -> Possible Format
forall a. Possible a
Absent})
      (Peeker e Format
forall e. LuaError e => Peeker e Format
peekFormat, \case
          RawBlock Format
_ Text
txt -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Format -> Block) -> Format -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Text -> Block
`RawBlock` Text
txt)
          Block
_              -> Possible Block -> Format -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e TableHead, Block -> Possible TableHead)
-> (Peeker e TableHead, Block -> TableHead -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"head" Text
"table head"
      (Pusher e TableHead
forall e. LuaError e => Pusher e TableHead
pushTableHead, \case {Table Attr
_ Caption
_ [ColSpec]
_ TableHead
h [TableBody]
_ TableFoot
_ -> TableHead -> Possible TableHead
forall a. a -> Possible a
Actual TableHead
h; Block
_ -> Possible TableHead
forall a. Possible a
Absent})
      (Peeker e TableHead
forall e. LuaError e => Peeker e TableHead
peekTableHead, \case
          Table Attr
attr Caption
c [ColSpec]
cs TableHead
_ [TableBody]
bs TableFoot
f  -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (TableHead -> Block) -> TableHead -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\TableHead
h -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
          Block
_                       -> Possible Block -> TableHead -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e Int, Block -> Possible Int)
-> (Peeker e Int, Block -> Int -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"level" Text
"heading level"
      (Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, \case {Header Int
lvl Attr
_ [Inline]
_ -> Int -> Possible Int
forall a. a -> Possible a
Actual Int
lvl; Block
_ -> Possible Int
forall a. Possible a
Absent})
      (Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \case
          Header Int
_ Attr
attr [Inline]
inlns -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Int -> Block) -> Int -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Int
lvl -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr [Inline]
inlns
          Block
_                   -> Possible Block -> Int -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e ListAttributes, Block -> Possible ListAttributes)
-> (Peeker e ListAttributes,
    Block -> ListAttributes -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"listAttributes" Text
"ordered list attributes"
      (Pusher e ListAttributes
forall e. LuaError e => Pusher e ListAttributes
pushListAttributes, \case
          OrderedList ListAttributes
listAttr [[Block]]
_ -> ListAttributes -> Possible ListAttributes
forall a. a -> Possible a
Actual ListAttributes
listAttr
          Block
_                      -> Possible ListAttributes
forall a. Possible a
Absent)
      (Peeker e ListAttributes
forall e. LuaError e => Peeker e ListAttributes
peekListAttributes, \case
          OrderedList ListAttributes
_ [[Block]]
content -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (ListAttributes -> Block) -> ListAttributes -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListAttributes -> [[Block]] -> Block
`OrderedList` [[Block]]
content)
          Block
_                     -> Possible Block -> ListAttributes -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e Text, Block -> Possible Text)
-> (Peeker e Text, Block -> Text -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"text" Text
"text contents"
      (Pusher e Text
forall e. Pusher e Text
pushText, Block -> Possible Text
getBlockText)
      (Peeker e Text
forall e. Peeker e Text
peekText, Block -> Text -> Possible Block
setBlockText)

  , Name
-> Text
-> (Pusher e String, Block -> String)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"tag" Text
"type of Block"
      (Pusher e String
forall e. String -> LuaE e ()
pushString, Constr -> String
showConstr (Constr -> String) -> (Block -> Constr) -> Block -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Constr
forall a. Data a => a -> Constr
toConstr )

  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"t" Text
"tag" [AliasIndex
"tag"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"c" Text
"content" [AliasIndex
"content"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"identifier" Text
"element identifier"       [AliasIndex
"attr", AliasIndex
"identifier"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"classes"    Text
"element classes"          [AliasIndex
"attr", AliasIndex
"classes"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"attributes" Text
"other element attributes" [AliasIndex
"attr", AliasIndex
"attributes"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"start"      Text
"ordered list start number" [AliasIndex
"listAttributes", AliasIndex
"start"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"style"      Text
"ordered list style"       [AliasIndex
"listAttributes", AliasIndex
"style"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"delimiter"  Text
"numbering delimiter"      [AliasIndex
"listAttributes", AliasIndex
"delimiter"]

  , DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Block)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall a b. (a -> b) -> a -> b
$ Name
-> (Block -> LuaE e Block)
-> HsFnPrecursor e (Block -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
    ### return
    HsFnPrecursor e (Block -> LuaE e Block)
-> Parameter e Block -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Block -> Text -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock Text
"Block" Text
"block" Text
"self"
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Block -> Text -> Text -> FunctionResults e Block
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock Text
"Block" Text
"cloned Block"

  , DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Block)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall a b. (a -> b) -> a -> b
$ Name
-> (Block -> LuaE e String)
-> HsFnPrecursor e (Block -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"show"
    ### liftPure show
    HsFnPrecursor e (Block -> LuaE e String)
-> Parameter e Block -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Block -> Text -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock Text
"Block" Text
"self" 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 -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString Text
"string" Text
"Haskell string representation"
  ]
 where
  boolResult :: Text -> FunctionResults e Bool
boolResult = Pusher e Bool -> Text -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool Text
"boolean"

getBlockContent :: Block -> Possible Content
getBlockContent :: Block -> Possible Content
getBlockContent = \case
  -- inline content
  Para [Inline]
inlns          -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Plain [Inline]
inlns         -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Header Int
_ Attr
_ [Inline]
inlns    -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  -- inline content
  BlockQuote [Block]
blks     -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
  Div Attr
_ [Block]
blks          -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
  -- lines content
  LineBlock [[Inline]]
lns       -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Content
ContentLines [[Inline]]
lns
  -- list items content
  BulletList [[Block]]
itms     -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Content
ContentListItems [[Block]]
itms
  OrderedList ListAttributes
_ [[Block]]
itms  -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Content
ContentListItems [[Block]]
itms
  -- definition items content
  DefinitionList [([Inline], [[Block]])]
itms -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [([Inline], [[Block]])] -> Content
ContentDefItems [([Inline], [[Block]])]
itms
  Block
_                   -> Possible Content
forall a. Possible a
Absent

setBlockContent :: Block -> Content -> Possible Block
setBlockContent :: Block -> Content -> Possible Block
setBlockContent = \case
  -- inline content
  Para [Inline]
_           -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Para ([Inline] -> Block) -> (Content -> [Inline]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Plain [Inline]
_          -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain ([Inline] -> Block) -> (Content -> [Inline]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Header Int
attr Attr
lvl [Inline]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Attr -> [Inline] -> Block
Header Int
attr Attr
lvl ([Inline] -> Block) -> (Content -> [Inline]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  -- block content
  BlockQuote [Block]
_     -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Block
BlockQuote ([Block] -> Block) -> (Content -> [Block]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
  Div Attr
attr [Block]
_       -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Block] -> Block
Div Attr
attr ([Block] -> Block) -> (Content -> [Block]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
  -- lines content
  LineBlock [[Inline]]
_      -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Inline]] -> Block
LineBlock ([[Inline]] -> Block)
-> (Content -> [[Inline]]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [[Inline]]
lineContent
  -- list items content
  BulletList [[Block]]
_     -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Block]] -> Block
BulletList ([[Block]] -> Block) -> (Content -> [[Block]]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [[Block]]
listItemContent
  OrderedList ListAttributes
la [[Block]]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
la ([[Block]] -> Block) -> (Content -> [[Block]]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [[Block]]
listItemContent
  -- definition items content
  DefinitionList [([Inline], [[Block]])]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Inline], [[Block]])] -> Block
DefinitionList ([([Inline], [[Block]])] -> Block)
-> (Content -> [([Inline], [[Block]])]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [([Inline], [[Block]])]
defItemContent
  Block
_                -> Possible Block -> Content -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent
  where
    inlineContent :: Content -> [Inline]
inlineContent = \case
      ContentInlines [Inline]
inlns -> [Inline]
inlns
      Content
c -> PandocError -> [Inline]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> [Inline])
-> (Text -> PandocError) -> Text -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError (Text -> [Inline]) -> Text -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text
"expected Inlines, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Content -> Text
contentTypeDescription Content
c
    blockContent :: Content -> [Block]
blockContent = \case
      ContentBlocks [Block]
blks   -> [Block]
blks
      ContentInlines [Inline]
inlns -> [[Inline] -> Block
Plain [Inline]
inlns]
      Content
c -> PandocError -> [Block]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> [Block])
-> (Text -> PandocError) -> Text -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError (Text -> [Block]) -> Text -> [Block]
forall a b. (a -> b) -> a -> b
$ Text
"expected Blocks, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Content -> Text
contentTypeDescription Content
c
    lineContent :: Content -> [[Inline]]
lineContent = \case
      ContentLines [[Inline]]
lns     -> [[Inline]]
lns
      Content
c -> PandocError -> [[Inline]]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> [[Inline]])
-> (Text -> PandocError) -> Text -> [[Inline]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError (Text -> [[Inline]]) -> Text -> [[Inline]]
forall a b. (a -> b) -> a -> b
$ Text
"expected list of lines, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Content -> Text
contentTypeDescription Content
c
    defItemContent :: Content -> [([Inline], [[Block]])]
defItemContent = \case
      ContentDefItems [([Inline], [[Block]])]
itms -> [([Inline], [[Block]])]
itms
      Content
c -> PandocError -> [([Inline], [[Block]])]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> [([Inline], [[Block]])])
-> (Text -> PandocError) -> Text -> [([Inline], [[Block]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError (Text -> [([Inline], [[Block]])])
-> Text -> [([Inline], [[Block]])]
forall a b. (a -> b) -> a -> b
$ Text
"expected definition items, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Content -> Text
contentTypeDescription Content
c
    listItemContent :: Content -> [[Block]]
listItemContent = \case
      ContentBlocks [Block]
blks    -> [[Block]
blks]
      ContentLines [[Inline]]
lns      -> ([Inline] -> [Block]) -> [[Inline]] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[]) (Block -> [Block]) -> ([Inline] -> Block) -> [Inline] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain) [[Inline]]
lns
      ContentListItems [[Block]]
itms -> [[Block]]
itms
      Content
c -> PandocError -> [[Block]]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> [[Block]])
-> (Text -> PandocError) -> Text -> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError (Text -> [[Block]]) -> Text -> [[Block]]
forall a b. (a -> b) -> a -> b
$ Text
"expected list of items, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Content -> Text
contentTypeDescription Content
c

getBlockText :: Block -> Possible Text
getBlockText :: Block -> Possible Text
getBlockText = \case
  CodeBlock Attr
_ Text
lst -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
lst
  RawBlock Format
_ Text
raw  -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
raw
  Block
_               -> Possible Text
forall a. Possible a
Absent

setBlockText :: Block -> Text -> Possible Block
setBlockText :: Block -> Text -> Possible Block
setBlockText = \case
  CodeBlock Attr
attr Text
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Text -> Block) -> Text -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Block
CodeBlock Attr
attr
  RawBlock Format
f Text
_     -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Text -> Block) -> Text -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text -> Block
RawBlock Format
f
  Block
_                -> Possible Block -> Text -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent

-- | Push a block element to the top of the Lua stack.
pushBlock :: forall e. LuaError e => Block -> LuaE e ()
pushBlock :: Block -> LuaE e ()
pushBlock = UDTypeWithList e (DocumentedFunction e) Block Void
-> Block -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Block Void
forall e. LuaError e => DocumentedType e Block
typeBlock

-- | Return the value at the given index as block if possible.
peekBlock :: forall e. LuaError e => Peeker e Block
peekBlock :: Peeker e Block
peekBlock = Name -> Peek e Block -> Peek e Block
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Block" (Peek e Block -> Peek e Block) -> Peeker e Block -> Peeker e Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UDTypeWithList e (DocumentedFunction e) Block Void
-> Peeker e Block
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) Block Void
forall e. LuaError e => DocumentedType e Block
typeBlock

-- | Retrieves a list of Block elements.
peekBlocks :: LuaError e => Peeker e [Block]
peekBlocks :: Peeker e [Block]
peekBlocks = Peeker e Block -> Peeker e [Block]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock

peekInlines :: LuaError e => Peeker e [Inline]
peekInlines :: Peeker e [Inline]
peekInlines = Peeker e Inline -> Peeker e [Inline]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline

pushInlines :: LuaError e => Pusher e [Inline]
pushInlines :: Pusher e [Inline]
pushInlines = Pusher e Inline -> Pusher e [Inline]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline

-- | Retrieves a single definition item from a the stack; it is expected
-- to be a pair of a list of inlines and a list of list of blocks. Uses
-- fuzzy parsing, i.e., tries hard to convert mismatching types into the
-- expected result.
peekDefinitionItem :: LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem :: Peeker e ([Inline], [[Block]])
peekDefinitionItem = Peeker e [Inline]
-> Peeker e [[Block]] -> Peeker e ([Inline], [[Block]])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy (Peeker e [[Block]] -> Peeker e ([Inline], [[Block]]))
-> Peeker e [[Block]] -> Peeker e ([Inline], [[Block]])
forall a b. (a -> b) -> a -> b
$ [Peeker e [[Block]]] -> Peeker e [[Block]]
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
  [ Peeker e [Block] -> Peeker e [[Block]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy
  , \StackIndex
idx -> ([Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[]) ([Block] -> [[Block]]) -> Peek e [Block] -> Peek e [[Block]]
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
  ]

-- | Push Caption element
pushCaption :: LuaError e => Caption -> LuaE e ()
pushCaption :: Caption -> LuaE e ()
pushCaption (Caption Maybe [Inline]
shortCaption [Block]
longCaption) = do
  LuaE e ()
forall e. LuaE e ()
Lua.newtable
  String -> Optional [Inline] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"short" (Maybe [Inline] -> Optional [Inline]
forall a. Maybe a -> Optional a
Lua.Optional Maybe [Inline]
shortCaption)
  String -> [Block] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"long" [Block]
longCaption

-- | Peek Caption element
peekCaption :: LuaError e => Peeker e Caption
peekCaption :: Peeker e Caption
peekCaption = 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)
-> Peeker e Caption -> Peeker e Caption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> do
  Maybe [Inline]
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]
peekInlines Name
"short" StackIndex
idx
  [Block]
long <- Peeker e [Block] -> Name -> Peeker e [Block]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks Name
"long" StackIndex
idx
  Caption -> Peek e Caption
forall (m :: * -> *) a. Monad m => a -> m a
return (Caption -> Peek e Caption) -> Caption -> Peek e Caption
forall a b. (a -> b) -> a -> b
$! Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
short [Block]
long

-- | Push a ColSpec value as a pair of Alignment and ColWidth.
pushColSpec :: LuaError e => Pusher e ColSpec
pushColSpec :: Pusher e ColSpec
pushColSpec = Pusher e Alignment -> Pusher e ColWidth -> Pusher e ColSpec
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair (String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> (Alignment -> String) -> Pusher e Alignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> String
forall a. Show a => a -> String
show) Pusher e ColWidth
forall e. LuaError e => Pusher e ColWidth
pushColWidth

-- | Peek a ColSpec value as a pair of Alignment and ColWidth.
peekColSpec :: LuaError e => Peeker e ColSpec
peekColSpec :: Peeker e ColSpec
peekColSpec = Peeker e Alignment -> Peeker e ColWidth -> Peeker e ColSpec
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Alignment
forall a e. Read a => Peeker e a
peekRead Peeker e ColWidth
forall e. LuaError e => Peeker e ColWidth
peekColWidth

peekColWidth :: LuaError e => Peeker e ColWidth
peekColWidth :: Peeker e ColWidth
peekColWidth = Name -> Peek e ColWidth -> Peek e ColWidth
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"ColWidth" (Peek e ColWidth -> Peek e ColWidth)
-> Peeker e ColWidth -> Peeker e ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> do
  ColWidth -> (Double -> ColWidth) -> Maybe Double -> ColWidth
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ColWidth
ColWidthDefault Double -> ColWidth
ColWidth (Maybe Double -> ColWidth)
-> Peek e (Maybe Double) -> Peek e ColWidth
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peek e Double -> Peek e (Maybe Double)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e Double
forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat StackIndex
idx)

-- | Push a ColWidth value by pushing the width as a plain number, or
-- @nil@ for ColWidthDefault.
pushColWidth :: LuaError e => Pusher e ColWidth
pushColWidth :: Pusher e ColWidth
pushColWidth = \case
  (ColWidth Double
w)    -> Double -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Double
w
  ColWidth
ColWidthDefault -> LuaE e ()
forall e. LuaE e ()
Lua.pushnil

-- | Push a table row as a pair of attr and the list of cells.
pushRow :: LuaError e => Pusher e Row
pushRow :: Pusher e Row
pushRow (Row Attr
attr [Cell]
cells) =
  Pusher e Attr -> Pusher e [Cell] -> (Attr, [Cell]) -> LuaE e ()
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr (Pusher e Cell -> Pusher e [Cell]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Cell
forall e. LuaError e => Cell -> LuaE e ()
pushCell) (Attr
attr, [Cell]
cells)

-- | Push a table row from a pair of attr and the list of cells.
peekRow :: LuaError e => Peeker e Row
peekRow :: Peeker e Row
peekRow = (((Attr -> [Cell] -> Row) -> (Attr, [Cell]) -> Row
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Attr -> [Cell] -> Row
Row) ((Attr, [Cell]) -> Row) -> Peek e (Attr, [Cell]) -> Peek e Row
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>)
  (Peek e (Attr, [Cell]) -> Peek e Row)
-> (StackIndex -> Peek e (Attr, [Cell])) -> Peeker e Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Peek e (Attr, [Cell]) -> Peek e (Attr, [Cell])
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Row"
  (Peek e (Attr, [Cell]) -> Peek e (Attr, [Cell]))
-> (StackIndex -> Peek e (Attr, [Cell]))
-> StackIndex
-> Peek e (Attr, [Cell])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Attr
-> Peeker e [Cell] -> StackIndex -> Peek e (Attr, [Cell])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr (Peeker e Cell -> Peeker e [Cell]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Cell
forall e. LuaError e => Peeker e Cell
peekCell)

-- | Pushes a 'TableBody' value as a Lua table with fields @attr@,
-- @row_head_columns@, @head@, and @body@.
pushTableBody :: LuaError e => Pusher e TableBody
pushTableBody :: Pusher e TableBody
pushTableBody (TableBody Attr
attr (RowHeadColumns Int
rowHeadColumns) [Row]
head' [Row]
body) = do
    LuaE e ()
forall e. LuaE e ()
Lua.newtable
    String -> Attr -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"attr" Attr
attr
    String -> Int -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"row_head_columns" Int
rowHeadColumns
    String -> [Row] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"head" [Row]
head'
    String -> [Row] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"body" [Row]
body

-- | Retrieves a 'TableBody' value from a Lua table with fields @attr@,
-- @row_head_columns@, @head@, and @body@.
peekTableBody :: LuaError e => Peeker e TableBody
peekTableBody :: Peeker e TableBody
peekTableBody = (Peek e TableBody -> Peek e TableBody)
-> Peeker e TableBody -> Peeker e TableBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Peek e TableBody -> Peek e TableBody
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"TableBody")
  (Peeker e TableBody -> Peeker e TableBody)
-> (Peeker e TableBody -> Peeker e TableBody)
-> Peeker e TableBody
-> Peeker e TableBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> (StackIndex -> LuaE e Bool)
-> Peeker e TableBody
-> Peeker e TableBody
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.istable
  (Peeker e TableBody -> Peeker e TableBody)
-> Peeker e TableBody -> Peeker e TableBody
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody
  (Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody)
-> Peek e Attr
-> Peek e (RowHeadColumns -> [Row] -> [Row] -> TableBody)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Attr -> Name -> Peeker e Attr
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Name
"attr" StackIndex
idx
  Peek e (RowHeadColumns -> [Row] -> [Row] -> TableBody)
-> Peek e RowHeadColumns -> Peek e ([Row] -> [Row] -> TableBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Peeker e RowHeadColumns -> Name -> Peeker e RowHeadColumns
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (((Int -> RowHeadColumns) -> Peek e Int -> Peek e RowHeadColumns
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> RowHeadColumns
RowHeadColumns) (Peek e Int -> Peek e RowHeadColumns)
-> (StackIndex -> Peek e Int) -> Peeker e RowHeadColumns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral) Name
"row_head_columns" StackIndex
idx
  Peek e ([Row] -> [Row] -> TableBody)
-> Peek e [Row] -> Peek e ([Row] -> TableBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Peeker e [Row] -> Name -> Peeker e [Row]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker e Row -> Peeker e [Row]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Row
forall e. LuaError e => Peeker e Row
peekRow) Name
"head" StackIndex
idx
  Peek e ([Row] -> TableBody) -> Peek e [Row] -> Peek e TableBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Peeker e [Row] -> Name -> Peeker e [Row]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker e Row -> Peeker e [Row]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Row
forall e. LuaError e => Peeker e Row
peekRow) Name
"body" StackIndex
idx

-- | Push a table head value as the pair of its Attr and rows.
pushTableHead :: LuaError e => Pusher e TableHead
pushTableHead :: Pusher e TableHead
pushTableHead (TableHead Attr
attr [Row]
rows) =
  Pusher e Attr -> Pusher e [Row] -> (Attr, [Row]) -> LuaE e ()
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr (Pusher e Row -> Pusher e [Row]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Row
forall e. LuaError e => Pusher e Row
pushRow) (Attr
attr, [Row]
rows)

-- | Peek a table head value from a pair of Attr and rows.
peekTableHead :: LuaError e => Peeker e TableHead
peekTableHead :: Peeker e TableHead
peekTableHead = (((Attr -> [Row] -> TableHead) -> (Attr, [Row]) -> TableHead
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Attr -> [Row] -> TableHead
TableHead) ((Attr, [Row]) -> TableHead)
-> Peek e (Attr, [Row]) -> Peek e TableHead
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>)
  (Peek e (Attr, [Row]) -> Peek e TableHead)
-> (StackIndex -> Peek e (Attr, [Row])) -> Peeker e TableHead
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Peek e (Attr, [Row]) -> Peek e (Attr, [Row])
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"TableHead"
  (Peek e (Attr, [Row]) -> Peek e (Attr, [Row]))
-> (StackIndex -> Peek e (Attr, [Row]))
-> StackIndex
-> Peek e (Attr, [Row])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Attr
-> Peeker e [Row] -> StackIndex -> Peek e (Attr, [Row])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr (Peeker e Row -> Peeker e [Row]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Row
forall e. LuaError e => Peeker e Row
peekRow)

-- | Pushes a 'TableFoot' value as a pair of the Attr value and the list
-- of table rows.
pushTableFoot :: LuaError e => Pusher e TableFoot
pushTableFoot :: Pusher e TableFoot
pushTableFoot (TableFoot Attr
attr [Row]
rows) =
  Pusher e Attr -> Pusher e [Row] -> (Attr, [Row]) -> LuaE e ()
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr (Pusher e Row -> Pusher e [Row]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Row
forall e. LuaError e => Pusher e Row
pushRow) (Attr
attr, [Row]
rows)

-- | Retrieves a 'TableFoot' value from a pair containing an Attr value
-- and a list of table rows.
peekTableFoot :: LuaError e => Peeker e TableFoot
peekTableFoot :: Peeker e TableFoot
peekTableFoot = (((Attr -> [Row] -> TableFoot) -> (Attr, [Row]) -> TableFoot
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Attr -> [Row] -> TableFoot
TableFoot) ((Attr, [Row]) -> TableFoot)
-> Peek e (Attr, [Row]) -> Peek e TableFoot
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>)
  (Peek e (Attr, [Row]) -> Peek e TableFoot)
-> (StackIndex -> Peek e (Attr, [Row])) -> Peeker e TableFoot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Peek e (Attr, [Row]) -> Peek e (Attr, [Row])
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"TableFoot"
  (Peek e (Attr, [Row]) -> Peek e (Attr, [Row]))
-> (StackIndex -> Peek e (Attr, [Row]))
-> StackIndex
-> Peek e (Attr, [Row])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Attr
-> Peeker e [Row] -> StackIndex -> Peek e (Attr, [Row])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr (Peeker e Row -> Peeker e [Row]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Row
forall e. LuaError e => Peeker e Row
peekRow)

instance Pushable Cell where
  push :: Cell -> LuaE e ()
push = Cell -> LuaE e ()
forall e. LuaError e => Cell -> LuaE e ()
pushCell

instance Peekable Cell where
  peek :: StackIndex -> LuaE e Cell
peek = Peek e Cell -> LuaE e Cell
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Cell -> LuaE e Cell)
-> (StackIndex -> Peek e Cell) -> StackIndex -> LuaE e Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Cell
forall e. LuaError e => Peeker e Cell
peekCell

-- | Push a table cell as a table with fields @attr@, @alignment@,
-- @row_span@, @col_span@, and @contents@.
pushCell :: LuaError e => Cell -> LuaE e ()
pushCell :: Cell -> LuaE e ()
pushCell (Cell Attr
attr Alignment
align (RowSpan Int
rowSpan) (ColSpan Int
colSpan) [Block]
contents) = do
  LuaE e ()
forall e. LuaE e ()
Lua.newtable
  String -> Attr -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"attr" Attr
attr
  String -> Alignment -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"alignment" Alignment
align
  String -> Int -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"row_span" Int
rowSpan
  String -> Int -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"col_span" Int
colSpan
  String -> [Block] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"contents" [Block]
contents

peekCell :: LuaError e => Peeker e Cell
peekCell :: Peeker e Cell
peekCell = (Peek e Cell -> Peek e Cell) -> Peeker e Cell -> Peeker e Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Peek e Cell -> Peek e Cell
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Cell")
  (Peeker e Cell -> Peeker e Cell)
-> (Peeker e Cell -> Peeker e Cell)
-> Peeker e Cell
-> Peeker e Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> (StackIndex -> LuaE e Bool) -> Peeker e Cell -> Peeker e Cell
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.istable
  (Peeker e Cell -> Peeker e Cell) -> Peeker e Cell -> Peeker e Cell
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
  Attr
attr <- Peeker e Attr -> Name -> Peeker e Attr
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Name
"attr" StackIndex
idx
  Alignment
algn <- Peeker e Alignment -> Name -> Peeker e Alignment
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Alignment
forall a e. Read a => Peeker e a
peekRead Name
"alignment" StackIndex
idx
  RowSpan
rs   <- Int -> RowSpan
RowSpan (Int -> RowSpan) -> Peek e Int -> Peek e RowSpan
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Int -> Name -> Peeker e Int
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Name
"row_span" StackIndex
idx
  ColSpan
cs   <- Int -> ColSpan
ColSpan (Int -> ColSpan) -> Peek e Int -> Peek e ColSpan
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Int -> Name -> Peeker e Int
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Name
"col_span" StackIndex
idx
  [Block]
blks <- Peeker e [Block] -> Name -> Peeker e [Block]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks Name
"contents" StackIndex
idx
  Cell -> Peek e Cell
forall (m :: * -> *) a. Monad m => a -> m a
return (Cell -> Peek e Cell) -> Cell -> Peek e Cell
forall a b. (a -> b) -> a -> b
$! Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
algn RowSpan
rs ColSpan
cs [Block]
blks

getInlineText :: Inline -> Possible Text
getInlineText :: Inline -> Possible Text
getInlineText = \case
  Code Attr
_ Text
lst      -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
lst
  Math MathType
_ Text
str      -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
str
  RawInline Format
_ Text
raw -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
raw
  Str Text
s           -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
s
  Inline
_               -> Possible Text
forall a. Possible a
Absent

setInlineText :: Inline -> Text -> Possible Inline
setInlineText :: Inline -> Text -> Possible Inline
setInlineText = \case
  Code Attr
attr Text
_     -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Inline
Code Attr
attr
  Math MathType
mt Text
_       -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> Text -> Inline
Math MathType
mt
  RawInline Format
f Text
_   -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text -> Inline
RawInline Format
f
  Str Text
_           -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Str
  Inline
_               -> Possible Inline -> Text -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent

-- | Helper type to represent all the different types a `content`
-- attribute can have.
data Content
  = ContentBlocks [Block]
  | ContentInlines [Inline]
  | ContentLines [[Inline]]
  | ContentDefItems [([Inline], [[Block]])]
  | ContentListItems [[Block]]

contentTypeDescription :: Content -> Text
contentTypeDescription :: Content -> Text
contentTypeDescription = \case
  ContentBlocks {}    -> Text
"list of Block items"
  ContentInlines {}   -> Text
"list of Inline items"
  ContentLines {}     -> Text
"list of Inline lists (i.e., a list of lines)"
  ContentDefItems {}  -> Text
"list of definition items items"
  ContentListItems {} -> Text
"list items (i.e., list of list of Block elements)"

pushContent :: LuaError e => Pusher e Content
pushContent :: Pusher e Content
pushContent = \case
  ContentBlocks [Block]
blks -> Pusher e Block -> Pusher e [Block]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock [Block]
blks
  ContentInlines [Inline]
inlns -> Pusher e Inline -> Pusher e [Inline]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline [Inline]
inlns
  ContentLines [[Inline]]
lns -> Pusher e [Inline] -> Pusher e [[Inline]]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (Pusher e Inline -> Pusher e [Inline]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline) [[Inline]]
lns
  ContentDefItems [([Inline], [[Block]])]
itms ->
    let pushItem :: ([Inline], [[Block]]) -> LuaE e ()
pushItem = Pusher e [Inline]
-> Pusher e [[Block]] -> ([Inline], [[Block]]) -> LuaE e ()
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair (Pusher e Inline -> Pusher e [Inline]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline)
                            (Pusher e [Block] -> Pusher e [[Block]]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (Pusher e Block -> Pusher e [Block]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock))
    in (([Inline], [[Block]]) -> LuaE e ())
-> Pusher e [([Inline], [[Block]])]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList ([Inline], [[Block]]) -> LuaE e ()
pushItem [([Inline], [[Block]])]
itms
  ContentListItems [[Block]]
itms ->
    Pusher e [Block] -> Pusher e [[Block]]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (Pusher e Block -> Pusher e [Block]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock) [[Block]]
itms

peekContent :: LuaError e => Peeker e Content
peekContent :: Peeker e Content
peekContent StackIndex
idx =
  ([Inline] -> Content
ContentInlines ([Inline] -> Content) -> Peek e [Inline] -> Peek e Content
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy StackIndex
idx) Peek e Content -> Peek e Content -> Peek e Content
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ([[Inline]] -> Content
ContentLines  ([[Inline]] -> Content) -> Peek e [[Inline]] -> Peek e Content
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Inline] -> Peeker e [[Inline]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList (Peeker e Inline -> Peeker e [Inline]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInlineFuzzy) StackIndex
idx) Peek e Content -> Peek e Content -> Peek e Content
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ([Block] -> Content
ContentBlocks  ([Block] -> Content) -> Peek e [Block] -> Peek e Content
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 Content -> Peek e Content -> Peek e Content
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ([[Block]] -> Content
ContentListItems ([[Block]] -> Content) -> Peek e [[Block]] -> Peek e Content
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Block] -> Peeker e [[Block]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx) Peek e Content -> Peek e Content -> Peek e Content
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ([([Inline], [[Block]])] -> Content
ContentDefItems  ([([Inline], [[Block]])] -> Content)
-> Peek e [([Inline], [[Block]])] -> Peek e Content
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e ([Inline], [[Block]]) -> Peeker e [([Inline], [[Block]])]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList (Peeker e ([Inline], [[Block]])
forall e. LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem) StackIndex
idx)

setInlineContent :: Inline -> Content -> Possible Inline
setInlineContent :: Inline -> Content -> Possible Inline
setInlineContent = \case
  -- inline content
  Cite [Citation]
cs [Inline]
_     -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Citation] -> [Inline] -> Inline
Cite [Citation]
cs ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Emph [Inline]
_        -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Emph ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Link Attr
a [Inline]
_ Target
tgt  -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Inline]
inlns -> Attr -> [Inline] -> Target -> Inline
Link Attr
a [Inline]
inlns Target
tgt) ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Quoted QuoteType
qt [Inline]
_   -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  SmallCaps [Inline]
_   -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
SmallCaps ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Span Attr
attr [Inline]
_   -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Inline
Span Attr
attr ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Strikeout [Inline]
_   -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Strikeout ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Strong [Inline]
_      -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Strong ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Subscript [Inline]
_   -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Subscript ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Superscript [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Superscript ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Underline [Inline]
_   -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Underline ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  -- block content
  Note [Block]
_        -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Inline
Note ([Block] -> Inline) -> (Content -> [Block]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
  Inline
_             -> Possible Inline -> Content -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent
  where
    inlineContent :: Content -> [Inline]
inlineContent = \case
      ContentInlines [Inline]
inlns -> [Inline]
inlns
      Content
c -> PandocError -> [Inline]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> [Inline])
-> (Text -> PandocError) -> Text -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError (Text -> [Inline]) -> Text -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text
"expected Inlines, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Content -> Text
contentTypeDescription Content
c
    blockContent :: Content -> [Block]
blockContent = \case
      ContentBlocks [Block]
blks -> [Block]
blks
      ContentInlines []  -> []
      Content
c -> PandocError -> [Block]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> [Block])
-> (Text -> PandocError) -> Text -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError (Text -> [Block]) -> Text -> [Block]
forall a b. (a -> b) -> a -> b
$ Text
"expected Blocks, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Content -> Text
contentTypeDescription Content
c

getInlineContent :: Inline -> Possible Content
getInlineContent :: Inline -> Possible Content
getInlineContent = \case
  Cite [Citation]
_ [Inline]
inlns      -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Emph [Inline]
inlns        -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Link Attr
_ [Inline]
inlns Target
_    -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Quoted QuoteType
_ [Inline]
inlns    -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  SmallCaps [Inline]
inlns   -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Span Attr
_ [Inline]
inlns      -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Strikeout [Inline]
inlns   -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Strong [Inline]
inlns      -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Subscript [Inline]
inlns   -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Superscript [Inline]
inlns -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Underline [Inline]
inlns   -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Note [Block]
blks         -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
  Inline
_                 -> Possible Content
forall a. Possible a
Absent

-- title
getInlineTitle :: Inline -> Possible Text
getInlineTitle :: Inline -> Possible Text
getInlineTitle = \case
  Image Attr
_ [Inline]
_ (Text
_, Text
tit) -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
tit
  Link Attr
_ [Inline]
_ (Text
_, Text
tit)  -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
tit
  Inline
_                  -> Possible Text
forall a. Possible a
Absent

setInlineTitle :: Inline -> Text -> Possible Inline
setInlineTitle :: Inline -> Text -> Possible Inline
setInlineTitle = \case
  Image Attr
attr [Inline]
capt (Text
src, Text
_) -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
capt (Target -> Inline) -> (Text -> Target) -> Text -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
src,)
  Link Attr
attr [Inline]
capt (Text
src, Text
_)  -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Target -> Inline
Link Attr
attr [Inline]
capt (Target -> Inline) -> (Text -> Target) -> Text -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
src,)
  Inline
_                        -> Possible Inline -> Text -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent

-- attr
getInlineAttr :: Inline -> Possible Attr
getInlineAttr :: Inline -> Possible Attr
getInlineAttr = \case
  Code Attr
attr Text
_    -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
  Image Attr
attr [Inline]
_ Target
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
  Link Attr
attr [Inline]
_ Target
_  -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
  Span Attr
attr [Inline]
_    -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
  Inline
_              -> Possible Attr
forall a. Possible a
Absent

setInlineAttr :: Inline -> Attr -> Possible Inline
setInlineAttr :: Inline -> Attr -> Possible Inline
setInlineAttr = \case
  Code Attr
_ Text
cs       -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Attr -> Inline) -> Attr -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Text -> Inline
`Code` Text
cs)
  Image Attr
_ [Inline]
cpt Target
tgt -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Attr -> Inline) -> Attr -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Attr
attr -> Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
cpt Target
tgt
  Link Attr
_ [Inline]
cpt Target
tgt  -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Attr -> Inline) -> Attr -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Attr
attr -> Attr -> [Inline] -> Target -> Inline
Link Attr
attr [Inline]
cpt Target
tgt
  Span Attr
_ [Inline]
inlns    -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Attr -> Inline) -> Attr -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> [Inline] -> Inline
`Span` [Inline]
inlns)
  Inline
_               -> Possible Inline -> Attr -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent

showInline :: LuaError e => DocumentedFunction e
showInline :: DocumentedFunction e
showInline = Name
-> (Inline -> LuaE e String)
-> HsFnPrecursor e (Inline -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"show"
  ### liftPure (show @Inline)
  HsFnPrecursor e (Inline -> LuaE e String)
-> Parameter e Inline -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Inline -> Text -> Text -> Text -> Parameter e Inline
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline Text
"inline" Text
"Inline" Text
"Object"
  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 -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString Text
"string" Text
"stringified Inline"

typeInline :: LuaError e => DocumentedType e Inline
typeInline :: DocumentedType e Inline
typeInline = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Inline]
-> DocumentedType e Inline
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Inline"
  [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
showInline
  , 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
$ Name
-> (Inline -> Inline -> LuaE e Bool)
-> HsFnPrecursor e (Inline -> Inline -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__eq"
      ### liftPure2 (==)
      HsFnPrecursor e (Inline -> Inline -> LuaE e Bool)
-> Parameter e Inline -> HsFnPrecursor e (Inline -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Inline -> Text -> Text -> Text -> Parameter e Inline
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline Text
"a" Text
"Inline" Text
""
      HsFnPrecursor e (Inline -> LuaE e Bool)
-> Parameter e Inline -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Inline -> Text -> Text -> Text -> Parameter e Inline
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline Text
"b" Text
"Inline" 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 -> Text -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool Text
"boolean" Text
"whether the two are equal"
  ]
  [ Name
-> Text
-> (Pusher e Attr, Inline -> Possible Attr)
-> (Peeker e Attr, Inline -> Attr -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"attr" Text
"element attributes"
      (Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr, Inline -> Possible Attr
getInlineAttr)
      (Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr, Inline -> Attr -> Possible Inline
setInlineAttr)
  , Name
-> Text
-> (Pusher e [Inline], Inline -> Possible [Inline])
-> (Peeker e [Inline], Inline -> [Inline] -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"caption" Text
"image caption"
      (Pusher e Inline -> Pusher e [Inline]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline, \case
          Image Attr
_ [Inline]
capt Target
_ -> [Inline] -> Possible [Inline]
forall a. a -> Possible a
Actual [Inline]
capt
          Inline
_              -> Possible [Inline]
forall a. Possible a
Absent)
      (Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy, \case
          Image Attr
attr [Inline]
_ Target
target -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> ([Inline] -> Inline) -> [Inline] -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Inline]
capt -> Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
capt Target
target)
          Inline
_                   -> Possible Inline -> [Inline] -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e [Citation], Inline -> Possible [Citation])
-> (Peeker e [Citation], Inline -> [Citation] -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"citations" Text
"list of citations"
      (Pusher e Citation -> Pusher e [Citation]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Citation
forall e. LuaError e => Pusher e Citation
pushCitation, \case {Cite [Citation]
cs [Inline]
_ -> [Citation] -> Possible [Citation]
forall a. a -> Possible a
Actual [Citation]
cs; Inline
_ -> Possible [Citation]
forall a. Possible a
Absent})
      (Peeker e Citation -> Peeker e [Citation]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Citation
forall e. LuaError e => Peeker e Citation
peekCitation, \case
          Cite [Citation]
_ [Inline]
inlns -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> ([Citation] -> Inline) -> [Citation] -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Citation] -> [Inline] -> Inline
`Cite` [Inline]
inlns)
          Inline
_            -> Possible Inline -> [Citation] -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e Content, Inline -> Possible Content)
-> (Peeker e Content, Inline -> Content -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"content" Text
"element contents"
      (Pusher e Content
forall e. LuaError e => Pusher e Content
pushContent, Inline -> Possible Content
getInlineContent)
      (Peeker e Content
forall e. LuaError e => Peeker e Content
peekContent, Inline -> Content -> Possible Inline
setInlineContent)
  , Name
-> Text
-> (Pusher e Format, Inline -> Possible Format)
-> (Peeker e Format, Inline -> Format -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"format" Text
"format of raw text"
      (Pusher e Format
forall e. LuaError e => Format -> LuaE e ()
pushFormat, \case {RawInline Format
fmt Text
_ -> Format -> Possible Format
forall a. a -> Possible a
Actual Format
fmt; Inline
_ -> Possible Format
forall a. Possible a
Absent})
      (Peeker e Format
forall e. LuaError e => Peeker e Format
peekFormat, \case
          RawInline Format
_ Text
txt -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Format -> Inline) -> Format -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Text -> Inline
`RawInline` Text
txt)
          Inline
_ -> Possible Inline -> Format -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e MathType, Inline -> Possible MathType)
-> (Peeker e MathType, Inline -> MathType -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"mathtype" Text
"math rendering method"
      (Pusher e MathType
forall e. LuaError e => MathType -> LuaE e ()
pushMathType, \case {Math MathType
mt Text
_ -> MathType -> Possible MathType
forall a. a -> Possible a
Actual MathType
mt; Inline
_ -> Possible MathType
forall a. Possible a
Absent})
      (Peeker e MathType
forall e. LuaError e => Peeker e MathType
peekMathType, \case
          Math MathType
_ Text
txt -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (MathType -> Inline) -> MathType -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MathType -> Text -> Inline
`Math` Text
txt)
          Inline
_          -> Possible Inline -> MathType -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e QuoteType, Inline -> Possible QuoteType)
-> (Peeker e QuoteType, Inline -> QuoteType -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"quotetype" Text
"type of quotes (single or double)"
      (Pusher e QuoteType
forall e. LuaError e => QuoteType -> LuaE e ()
pushQuoteType, \case {Quoted QuoteType
qt [Inline]
_ -> QuoteType -> Possible QuoteType
forall a. a -> Possible a
Actual QuoteType
qt; Inline
_ -> Possible QuoteType
forall a. Possible a
Absent})
      (Peeker e QuoteType
forall e. LuaError e => Peeker e QuoteType
peekQuoteType, \case
          Quoted QuoteType
_ [Inline]
inlns  -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (QuoteType -> Inline) -> QuoteType -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QuoteType -> [Inline] -> Inline
`Quoted` [Inline]
inlns)
          Inline
_               -> Possible Inline -> QuoteType -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e Text, Inline -> Possible Text)
-> (Peeker e Text, Inline -> Text -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"src" Text
"image source"
      (Pusher e Text
forall e. Pusher e Text
pushText, \case
          Image Attr
_ [Inline]
_ (Text
src, Text
_) -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
src
          Inline
_                  -> Possible Text
forall a. Possible a
Absent)
      (Peeker e Text
forall e. Peeker e Text
peekText, \case
          Image Attr
attr [Inline]
capt (Text
_, Text
title) -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
capt (Target -> Inline) -> (Text -> Target) -> Text -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Text
title)
          Inline
_                          -> Possible Inline -> Text -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e Text, Inline -> Possible Text)
-> (Peeker e Text, Inline -> Text -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"target" Text
"link target URL"
      (Pusher e Text
forall e. Pusher e Text
pushText, \case
          Link Attr
_ [Inline]
_ (Text
tgt, Text
_) -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
tgt
          Inline
_                 -> Possible Text
forall a. Possible a
Absent)
      (Peeker e Text
forall e. Peeker e Text
peekText, \case
          Link Attr
attr [Inline]
capt (Text
_, Text
title) -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Target -> Inline
Link Attr
attr [Inline]
capt (Target -> Inline) -> (Text -> Target) -> Text -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Text
title)
          Inline
_                         -> Possible Inline -> Text -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
  , Name
-> Text
-> (Pusher e Text, Inline -> Possible Text)
-> (Peeker e Text, Inline -> Text -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"title" Text
"title text"
      (Pusher e Text
forall e. Pusher e Text
pushText, Inline -> Possible Text
getInlineTitle)
      (Peeker e Text
forall e. Peeker e Text
peekText, Inline -> Text -> Possible Inline
setInlineTitle)
  , Name
-> Text
-> (Pusher e Text, Inline -> Possible Text)
-> (Peeker e Text, Inline -> Text -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"text" Text
"text contents"
      (Pusher e Text
forall e. Pusher e Text
pushText, Inline -> Possible Text
getInlineText)
      (Peeker e Text
forall e. Peeker e Text
peekText, Inline -> Text -> Possible Inline
setInlineText)
  , Name
-> Text
-> (Pusher e String, Inline -> String)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"tag" Text
"type of Inline"
      (Pusher e String
forall e. String -> LuaE e ()
pushString, Constr -> String
showConstr (Constr -> String) -> (Inline -> Constr) -> Inline -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Constr
forall a. Data a => a -> Constr
toConstr )

  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"t" Text
"tag" [AliasIndex
"tag"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"c" Text
"content" [AliasIndex
"content"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"identifier" Text
"element identifier"       [AliasIndex
"attr", AliasIndex
"identifier"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"classes"    Text
"element classes"          [AliasIndex
"attr", AliasIndex
"classes"]
  , Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"attributes" Text
"other element attributes" [AliasIndex
"attr", AliasIndex
"attributes"]

  , DocumentedFunction e -> Member e (DocumentedFunction e) Inline
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Inline)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Inline
forall a b. (a -> b) -> a -> b
$ Name
-> (Inline -> LuaE e Inline)
-> HsFnPrecursor e (Inline -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
      ### return
      HsFnPrecursor e (Inline -> LuaE e Inline)
-> Parameter e Inline -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Inline -> Text -> Text -> Text -> Parameter e Inline
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline Text
"inline" Text
"Inline" Text
"self"
      HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"cloned Inline"
  ]

-- | Push an inline element to the top of the lua stack.
pushInline :: forall e. LuaError e => Inline -> LuaE e ()
pushInline :: Inline -> LuaE e ()
pushInline = UDTypeWithList e (DocumentedFunction e) Inline Void
-> Inline -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Inline Void
forall e. LuaError e => DocumentedType e Inline
typeInline

-- | Return the value at the given index as inline if possible.
peekInline :: forall e. LuaError e => Peeker e Inline
peekInline :: Peeker e Inline
peekInline = Name -> Peek e Inline -> Peek e Inline
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Inline" (Peek e Inline -> Peek e Inline)
-> Peeker e Inline -> Peeker e Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> UDTypeWithList e (DocumentedFunction e) Inline Void
-> Peeker e Inline
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) Inline Void
forall e. LuaError e => DocumentedType e Inline
typeInline StackIndex
idx

-- | Try extra hard to retrieve an Inline value from the stack. Treats
-- bare strings as @Str@ values.
peekInlineFuzzy :: LuaError e => Peeker e Inline
peekInlineFuzzy :: Peeker e Inline
peekInlineFuzzy = Name -> Peek e Inline -> Peek e Inline
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Inline" (Peek e Inline -> Peek e Inline)
-> Peeker e Inline -> Peeker e Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Peeker e Inline] -> Peeker e Inline
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
  [ UDTypeWithList e (DocumentedFunction e) Inline Void
-> Peeker e Inline
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) Inline Void
forall e. LuaError e => DocumentedType e Inline
typeInline
  , \StackIndex
idx -> Text -> Inline
Str (Text -> Inline) -> Peek e Text -> Peek e Inline
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
  ]

-- | Try extra-hard to return the value at the given index as a list of
-- inlines.
peekInlinesFuzzy :: LuaError e => Peeker e [Inline]
peekInlinesFuzzy :: Peeker e [Inline]
peekInlinesFuzzy = [Peeker e [Inline]] -> Peeker e [Inline]
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
  [ Peeker e Inline -> Peeker e [Inline]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInlineFuzzy
  , (Inline -> [Inline]) -> Peek e Inline -> Peek e [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Inline -> [Inline]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peek e Inline -> Peek e [Inline])
-> Peeker e Inline -> Peeker e [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInlineFuzzy
  ]

-- | Try extra hard to retrieve a Block value from the stack. Treats bar
-- Inline elements as if they were wrapped in 'Plain'.
peekBlockFuzzy :: LuaError e => Peeker e Block
peekBlockFuzzy :: Peeker e Block
peekBlockFuzzy = [Peeker e Block] -> Peeker e Block
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
  [ Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock
  , (\StackIndex
idx -> [Inline] -> Block
Plain ([Inline] -> Block) -> Peek e [Inline] -> Peek e Block
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy StackIndex
idx)
  ]

-- | Try extra-hard to return the value at the given index as a list of
-- blocks.
peekBlocksFuzzy :: LuaError e => Peeker e [Block]
peekBlocksFuzzy :: Peeker e [Block]
peekBlocksFuzzy = [Peeker e [Block]] -> Peeker e [Block]
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
  [ Peeker e Block -> Peeker e [Block]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlockFuzzy
  , (Block -> [Block]) -> Peek e Block -> Peek e [Block]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) Block -> [Block]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peek e Block -> Peek e [Block])
-> Peeker e Block -> Peeker e [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlockFuzzy
  ]

-- * Orphan Instances

instance Pushable Inline where
  push :: Inline -> LuaE e ()
push = Inline -> LuaE e ()
forall e. LuaError e => Inline -> LuaE e ()
pushInline

instance Pushable Citation where
  push :: Citation -> LuaE e ()
push = Citation -> LuaE e ()
forall e. LuaError e => Pusher e Citation
pushCitation

instance Pushable Row where
  push :: Row -> LuaE e ()
push = Row -> LuaE e ()
forall e. LuaError e => Pusher e Row
pushRow

instance Pushable TableBody where
  push :: TableBody -> LuaE e ()
push = TableBody -> LuaE e ()
forall e. LuaError e => Pusher e TableBody
pushTableBody

instance Pushable TableFoot where
  push :: TableFoot -> LuaE e ()
push = TableFoot -> LuaE e ()
forall e. LuaError e => Pusher e TableFoot
pushTableFoot

instance Pushable TableHead where
  push :: TableHead -> LuaE e ()
push = TableHead -> LuaE e ()
forall e. LuaError e => Pusher e TableHead
pushTableHead

-- These instances exist only for testing. It's a hack to avoid making
-- the marshalling modules public.
instance Peekable Inline where
  peek :: StackIndex -> LuaE e Inline
peek = Peek e Inline -> LuaE e Inline
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Inline -> LuaE e Inline)
-> (StackIndex -> Peek e Inline) -> StackIndex -> LuaE e Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Inline
forall e. LuaError e => Peeker e Inline
peekInline

instance Peekable Block where
  peek :: StackIndex -> LuaE e Block
peek = Peek e Block -> LuaE e Block
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Block -> LuaE e Block)
-> (StackIndex -> Peek e Block) -> StackIndex -> LuaE e Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlock

instance Peekable Meta where
  peek :: StackIndex -> LuaE e Meta
peek = Peek e Meta -> LuaE e Meta
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Meta -> LuaE e Meta)
-> (StackIndex -> Peek e Meta) -> StackIndex -> LuaE e Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Meta
forall e. LuaError e => Peeker e Meta
peekMeta

instance Peekable Pandoc where
  peek :: StackIndex -> LuaE e Pandoc
peek = Peek e Pandoc -> LuaE e Pandoc
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Pandoc -> LuaE e Pandoc)
-> (StackIndex -> Peek e Pandoc) -> StackIndex -> LuaE e Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc

instance Peekable Row where
  peek :: StackIndex -> LuaE e Row
peek = Peek e Row -> LuaE e Row
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Row -> LuaE e Row)
-> (StackIndex -> Peek e Row) -> StackIndex -> LuaE e Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Row
forall e. LuaError e => Peeker e Row
peekRow

instance Peekable Version where
  peek :: StackIndex -> LuaE e Version
peek = Peek e Version -> LuaE e Version
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Version -> LuaE e Version)
-> (StackIndex -> Peek e Version) -> StackIndex -> LuaE e Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Version
forall e. LuaError e => Peeker e Version
peekVersionFuzzy

instance {-# OVERLAPPING #-} Peekable Attr where
  peek :: StackIndex -> LuaE e Attr
peek = Peek e Attr -> LuaE e Attr
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Attr -> LuaE e Attr)
-> (StackIndex -> Peek e Attr) -> StackIndex -> LuaE e Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Attr
forall e. LuaError e => Peeker e Attr
peekAttr