{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TupleSections        #-}
{- |

Marshal values of types that make up 'Inline' elements.
-}
module Text.Pandoc.Lua.Marshal.Inline
  ( typeInline
    -- * Single Inline elements
  , peekInline
  , peekInlineFuzzy
  , pushInline
    -- * List of Inlines
  , peekInlines
  , peekInlinesFuzzy
  , pushInlines
    -- * Constructors
  , inlineConstructors
  , mkInlines
    -- * Walking
  , walkInlineSplicing
  , walkInlinesStraight
  ) where

import Control.Applicative ((<|>), optional)
import Control.Monad.Catch (throwM)
import Control.Monad ((<$!>))
import Data.Aeson (encode)
import Data.Data (showConstr, toConstr)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import HsLua
import Text.Pandoc.Definition (Inline (..), nullAttr)
import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)
import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy)
import Text.Pandoc.Lua.Marshal.Citation (peekCitation, pushCitation)
import Text.Pandoc.Lua.Marshal.Content
  ( Content (..), contentTypeDescription, peekContent, pushContent )
import Text.Pandoc.Lua.Marshal.Filter (Filter, peekFilter)
import Text.Pandoc.Lua.Marshal.Format (peekFormat, pushFormat)
import Text.Pandoc.Lua.Marshal.List (pushPandocList, newListMetatable)
import Text.Pandoc.Lua.Marshal.MathType (peekMathType, pushMathType)
import Text.Pandoc.Lua.Marshal.QuoteType (peekQuoteType, pushQuoteType)
import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines)
import Text.Pandoc.Lua.Walk (SpliceList, Walkable, walkSplicing, walkStraight)
import qualified Text.Pandoc.Builder as B

-- | Pushes an Inline value as userdata object.
pushInline :: LuaError e => Pusher e Inline
pushInline :: forall e. LuaError e => Pusher e Inline
pushInline = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e Inline
typeInline
{-# INLINE pushInline #-}

-- | Retrieves an Inline value.
peekInline :: LuaError e => Peeker e Inline
peekInline :: forall e. LuaError e => Peeker e Inline
peekInline = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e Inline
typeInline
{-# INLINE peekInline #-}

-- | Retrieves a list of Inline values.
peekInlines :: LuaError e
            => Peeker e [Inline]
peekInlines :: forall e. LuaError e => Peeker e [Inline]
peekInlines = forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Inline
peekInline
{-# INLINABLE peekInlines #-}

-- | Pushes a list of Inline values.
pushInlines :: LuaError e
            => Pusher e [Inline]
pushInlines :: forall e. LuaError e => Pusher e [Inline]
pushInlines [Inline]
xs = do
  forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => Pusher e Inline
pushInline [Inline]
xs
  forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
"Inlines" forall a b. (a -> b) -> a -> b
$ do
    forall e. Name -> LuaE e ()
pushName Name
"walk"
    forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
      ### flip walkBlocksAndInlines
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Blocks" Text
"self" Text
""
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Filter
peekFilter TypeSpec
"Filter" Text
"lua_filter" Text
"table of filter functions"
      forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e [Inline]
pushInlines TypeSpec
"Blocks" Text
"modified list"
    forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

    forall e. Name -> LuaE e ()
pushName Name
"__tostring"
    forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
      ### liftPure show
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"self" Text
""
      forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"native Haskell representation"
    forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

    forall e. Name -> LuaE e ()
pushName Name
"__tojson"
    forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
      ### liftPure encode
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"self" Text
""
      forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
    forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
{-# INLINABLE pushInlines #-}

-- | Try extra hard to retrieve an Inline value from the stack. Treats
-- bare strings as @Str@ values.
peekInlineFuzzy :: LuaError e => Peeker e Inline
peekInlineFuzzy :: forall e. LuaError e => Peeker e Inline
peekInlineFuzzy StackIndex
idx = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Inline" forall a b. (a -> b) -> a -> b
$ forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeString   -> Text -> Inline
Str forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. Peeker e Text
peekText StackIndex
idx
  Type
_            -> forall e. LuaError e => Peeker e Inline
peekInline StackIndex
idx
{-# INLINABLE peekInlineFuzzy #-}

-- | Try extra-hard to return the value at the given index as a list of
-- inlines.
peekInlinesFuzzy :: LuaError e
                 => Peeker e [Inline]
peekInlinesFuzzy :: forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy StackIndex
idx = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeString -> forall a. Many a -> [a]
B.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Peeker e Text
peekText StackIndex
idx
  Type
_ ->  forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Inline
peekInlineFuzzy StackIndex
idx
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. LuaError e => Peeker e Inline
peekInlineFuzzy StackIndex
idx)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
         forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Inline, list of Inlines, or string" StackIndex
idx)
{-# INLINABLE peekInlinesFuzzy #-}

-- | Inline object type.
typeInline :: forall e. LuaError e => DocumentedType e Inline
typeInline :: forall e. LuaError e => DocumentedType e Inline
typeInline = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Inline"
  [ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure (show @Inline)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Inline
peekInline TypeSpec
"inline" Text
"Inline" Text
"Object"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"stringified Inline"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__eq"
      ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Inline
peekInline) TypeSpec
"a" Text
"Inline" Text
""
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Inline
peekInline) TypeSpec
"b" Text
"Inline" Text
""
      forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e Bool
pushBool TypeSpec
"boolean" Text
"whether the two are equal"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation (Name -> Operation
CustomOperation Name
"__tojson") forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure encode
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e Inline
typeInline Text
"self" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
  ]
  [ forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"attr" Text
"element attributes"
      (forall e. LuaError e => Pusher e Attr
pushAttr, \case
          Code Attr
attr Text
_    -> forall a. a -> Possible a
Actual Attr
attr
          Image Attr
attr [Inline]
_ Target
_ -> forall a. a -> Possible a
Actual Attr
attr
          Link Attr
attr [Inline]
_ Target
_  -> forall a. a -> Possible a
Actual Attr
attr
          Span Attr
attr [Inline]
_    -> forall a. a -> Possible a
Actual Attr
attr
          Inline
_              -> forall a. Possible a
Absent)
      (forall e. LuaError e => Peeker e Attr
peekAttr, \case
          Code Attr
_ Text
cs       -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Text -> Inline
`Code` Text
cs)
          Image Attr
_ [Inline]
cpt Target
tgt -> forall a. a -> Possible a
Actual 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  -> forall a. a -> Possible a
Actual 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    -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> [Inline] -> Inline
`Span` [Inline]
inlns)
          Inline
_               -> forall a b. a -> b -> a
const forall a. Possible a
Absent)

  , 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"
      (forall e. LuaError e => Pusher e [Inline]
pushInlines, \case
          Image Attr
_ [Inline]
capt Target
_ -> forall a. a -> Possible a
Actual [Inline]
capt
          Inline
_              -> forall a. Possible a
Absent)
      (forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy, \case
          Image Attr
attr [Inline]
_ Target
target -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Inline]
capt -> Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
capt Target
target)
          Inline
_                   -> forall a b. a -> b -> a
const forall a. Possible a
Absent)

  , 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"
      (forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushPandocList forall e. LuaError e => Pusher e Citation
pushCitation, \case
          Cite [Citation]
cs [Inline]
_    -> forall a. a -> Possible a
Actual [Citation]
cs
          Inline
_            -> forall a. Possible a
Absent)
      (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Citation
peekCitation, \case
          Cite [Citation]
_ [Inline]
inlns -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Citation] -> [Inline] -> Inline
`Cite` [Inline]
inlns)
          Inline
_            -> forall a b. a -> b -> a
const forall a. Possible a
Absent)

  , 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"
      (forall e. LuaError e => Pusher e Content
pushContent, \case
          Cite [Citation]
_ [Inline]
inlns      -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Emph [Inline]
inlns        -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Link Attr
_ [Inline]
inlns Target
_    -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Quoted QuoteType
_ [Inline]
inlns    -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          SmallCaps [Inline]
inlns   -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Span Attr
_ [Inline]
inlns      -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Strikeout [Inline]
inlns   -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Strong [Inline]
inlns      -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Subscript [Inline]
inlns   -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Superscript [Inline]
inlns -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Underline [Inline]
inlns   -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
          Note [Block]
blks         -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
          Inline
_                 -> forall a. Possible a
Absent)
      (forall e. LuaError e => Peeker e Content
peekContent,
        let inlineContent :: Content -> [Inline]
inlineContent = \case
              ContentInlines [Inline]
inlns -> [Inline]
inlns
              Content
c -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e forall a b. (a -> b) -> a -> b
$
                   String
"expected Inlines, got " forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
            blockContent :: Content -> [Block]
blockContent = \case
              ContentBlocks [Block]
blks -> [Block]
blks
              ContentInlines []  -> []
              Content
c -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e forall a b. (a -> b) -> a -> b
$
                   String
"expected Blocks, got " forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
        in \case
          -- inline content
          Cite [Citation]
cs [Inline]
_     -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Citation] -> [Inline] -> Inline
Cite [Citation]
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          Emph [Inline]
_        -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Emph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          Link Attr
a [Inline]
_ Target
tgt  -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Inline]
inlns -> Attr -> [Inline] -> Target -> Inline
Link Attr
a [Inline]
inlns Target
tgt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          Quoted QuoteType
qt [Inline]
_   -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          SmallCaps [Inline]
_   -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
SmallCaps forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          Span Attr
attr [Inline]
_   -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Inline
Span Attr
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          Strikeout [Inline]
_   -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Strikeout forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          Strong [Inline]
_      -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Strong forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          Subscript [Inline]
_   -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Subscript forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          Superscript [Inline]
_ -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Superscript forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          Underline [Inline]
_   -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Underline forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
          -- block content
          Note [Block]
_        -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Inline
Note forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
          Inline
_             -> forall a b. a -> b -> a
const forall a. Possible a
Absent
      )

  , 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"
      (forall e. Pusher e Format
pushFormat, \case
          RawInline Format
fmt Text
_ -> forall a. a -> Possible a
Actual Format
fmt
          Inline
_               -> forall a. Possible a
Absent)
      (forall e. Peeker e Format
peekFormat, \case
          RawInline Format
_ Text
txt -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Text -> Inline
`RawInline` Text
txt)
          Inline
_               -> forall a b. a -> b -> a
const forall a. Possible a
Absent)

  , 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"
      (forall e. Pusher e MathType
pushMathType, \case
          Math MathType
mt Text
_  -> forall a. a -> Possible a
Actual MathType
mt
          Inline
_          -> forall a. Possible a
Absent)
      (forall e. Peeker e MathType
peekMathType, \case
          Math MathType
_ Text
txt -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MathType -> Text -> Inline
`Math` Text
txt)
          Inline
_          -> forall a b. a -> b -> a
const forall a. Possible a
Absent)

  , 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)"
      (forall e. Pusher e QuoteType
pushQuoteType, \case
          Quoted QuoteType
qt [Inline]
_     -> forall a. a -> Possible a
Actual QuoteType
qt
          Inline
_               -> forall a. Possible a
Absent)
      (forall e. Peeker e QuoteType
peekQuoteType, \case
          Quoted QuoteType
_ [Inline]
inlns  -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QuoteType -> [Inline] -> Inline
`Quoted` [Inline]
inlns)
          Inline
_               -> forall a b. a -> b -> a
const forall a. Possible a
Absent)

  , 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"
      (forall e. Pusher e Text
pushText, \case
          Image Attr
_ [Inline]
_ (Text
src, Text
_) -> forall a. a -> Possible a
Actual Text
src
          Inline
_                  -> forall a. Possible a
Absent)
      (forall e. Peeker e Text
peekText, \case
          Image Attr
attr [Inline]
capt (Text
_, Text
title) -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
capt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Text
title)
          Inline
_                          -> forall a b. a -> b -> a
const forall a. Possible a
Absent)

  , 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"
      (forall e. Pusher e Text
pushText, \case
          Link Attr
_ [Inline]
_ (Text
tgt, Text
_) -> forall a. a -> Possible a
Actual Text
tgt
          Inline
_                 -> forall a. Possible a
Absent)
      (forall e. Peeker e Text
peekText, \case
          Link Attr
attr [Inline]
capt (Text
_, Text
title) -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Target -> Inline
Link Attr
attr [Inline]
capt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Text
title)
          Inline
_                         -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall e. Pusher e Text
pushText, \case
          Image Attr
_ [Inline]
_ (Text
_, Text
tit) -> forall a. a -> Possible a
Actual Text
tit
          Link Attr
_ [Inline]
_ (Text
_, Text
tit)  -> forall a. a -> Possible a
Actual Text
tit
          Inline
_                  -> forall a. Possible a
Absent)
      (forall e. Peeker e Text
peekText, \case
          Image Attr
attr [Inline]
capt (Text
src, Text
_) -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
capt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
src,)
          Link Attr
attr [Inline]
capt (Text
src, Text
_)  -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Target -> Inline
Link Attr
attr [Inline]
capt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
src,)
          Inline
_                        -> forall a b. a -> b -> a
const forall a. Possible a
Absent)

  , 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"
      (forall e. Pusher e Text
pushText, Inline -> Possible Text
getInlineText)
      (forall e. Peeker e Text
peekText, Inline -> Text -> Possible Inline
setInlineText)

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

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

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

  , forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"walk"
    ### flip walkBlocksAndInlines
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Inline
peekInline TypeSpec
"Inline" Text
"self" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Filter
peekFilter TypeSpec
"Filter" Text
"lua_filter" Text
"table of filter functions"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"modified element"
  ]

--
-- Text
--

-- | Gets the text property of an Inline, if present.
getInlineText :: Inline -> Possible Text
getInlineText :: Inline -> Possible Text
getInlineText = \case
  Code Attr
_ Text
lst      -> forall a. a -> Possible a
Actual Text
lst
  Math MathType
_ Text
str      -> forall a. a -> Possible a
Actual Text
str
  RawInline Format
_ Text
raw -> forall a. a -> Possible a
Actual Text
raw
  Str Text
s           -> forall a. a -> Possible a
Actual Text
s
  Inline
_               -> forall a. Possible a
Absent

-- | Sets the text property of an Inline, if present.
setInlineText :: Inline -> Text -> Possible Inline
setInlineText :: Inline -> Text -> Possible Inline
setInlineText = \case
  Code Attr
attr Text
_     -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Inline
Code Attr
attr
  Math MathType
mt Text
_       -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> Text -> Inline
Math MathType
mt
  RawInline Format
f Text
_   -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text -> Inline
RawInline Format
f
  Str Text
_           -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Str
  Inline
_               -> forall a b. a -> b -> a
const forall a. Possible a
Absent

-- | Constructor functions for 'Inline' elements.
inlineConstructors :: LuaError e =>  [DocumentedFunction e]
inlineConstructors :: forall e. LuaError e => [DocumentedFunction e]
inlineConstructors =
  [ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Cite"
    ### liftPure2 (flip Cite)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"content" Text
"Inline" Text
"placeholder content"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Citation
peekCitation) TypeSpec
"citations" Text
"list of Citations" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"cite element"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Code"
    ### liftPure2 (\text mattr -> Code (fromMaybe nullAttr mattr) text)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"code" Text
"code string"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Attr
peekAttr TypeSpec
"Attr" Text
"attr" Text
"additional attributes")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"code element"
  , forall {e}.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Emph" [Inline] -> Inline
Emph
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Image"
    ### liftPure4 (\caption src mtitle mattr ->
                     let attr = fromMaybe nullAttr mattr
                         title = fromMaybe mempty mtitle
                     in Image attr caption (src, title))
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"caption" Text
"image caption / alt"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"src" Text
"path/URL of the image file"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Text
textParam Text
"title" Text
"brief image description")
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Attr
peekAttr TypeSpec
"Attr" Text
"attr" Text
"image attributes")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"image element"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"LineBreak"
    ### return LineBreak
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"line break"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Link"
    ### liftPure4 (\content target mtitle mattr ->
                     let attr = fromMaybe nullAttr mattr
                         title = fromMaybe mempty mtitle
                     in Link attr content (target, title))
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"content" Text
"text for this link"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"target" Text
"the link target"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Text
textParam Text
"title" Text
"brief link description")
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Attr
peekAttr TypeSpec
"Attr" Text
"attr" Text
"link attributes")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"link element"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Math"
    ### liftPure2 Math
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e MathType
peekMathType TypeSpec
"quotetype" Text
"Math" Text
"rendering method"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"text" Text
"math content"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"math element"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Note"
    ### liftPure Note
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"content" Text
"Blocks" Text
"note content"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"note"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Quoted"
    ### liftPure2 Quoted
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e QuoteType
peekQuoteType TypeSpec
"quotetype" Text
"QuoteType" Text
"type of quotes"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"content" Text
"Inlines" Text
"inlines in quotes"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"quoted element"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"RawInline"
    ### liftPure2 RawInline
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. Peeker e Format
peekFormat TypeSpec
"format" Text
"Format" Text
"format of content"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"text" Text
"string content"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"raw inline element"
  , forall {e}.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"SmallCaps" [Inline] -> Inline
SmallCaps
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"SoftBreak"
    ### return SoftBreak
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"soft break"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Space"
    ### return Space
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"new space"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Span"
    ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"content" Text
"Inlines" Text
"inline content"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Attr
peekAttr TypeSpec
"Attr" Text
"attr" Text
"additional attributes")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"span element"
  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Str"
    ### liftPure Str
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"text" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"new Str object"
  , forall {e}.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Strong" [Inline] -> Inline
Strong
  , forall {e}.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Strikeout" [Inline] -> Inline
Strikeout
  , forall {e}.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Subscript" [Inline] -> Inline
Subscript
  , forall {e}.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Superscript" [Inline] -> Inline
Superscript
  , forall {e}.
LuaError e =>
Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
"Underline" [Inline] -> Inline
Underline
  ]
 where
   mkInlinesConstr :: Name -> ([Inline] -> Inline) -> DocumentedFunction e
mkInlinesConstr Name
name [Inline] -> Inline
constr = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
name
     ### liftPure (\x -> x `seq` constr x)
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"content" Text
""
     forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline TypeSpec
"Inline" Text
"new object"

-- | Constructor for a list of `Inline` values.
mkInlines :: LuaError e => DocumentedFunction e
mkInlines :: forall e. LuaError e => DocumentedFunction e
mkInlines = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Inlines"
  ### liftPure id
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"inlines" Text
"inline elements"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e [Inline]
pushInlines TypeSpec
"Inlines" Text
"list of inline elements"

-- | Walks an element of type @a@ and applies the filter to all 'Inline'
-- elements.  The filter result is spliced back into the list.
walkInlineSplicing :: (LuaError e, Walkable (SpliceList Inline) a)
                   => Filter -> a -> LuaE e a
walkInlineSplicing :: forall e a.
(LuaError e, Walkable (SpliceList Inline) a) =>
Filter -> a -> LuaE e a
walkInlineSplicing = forall e a b.
(LuaError e, Data a, Walkable (SpliceList a) b) =>
Pusher e a -> Peeker e [a] -> Filter -> b -> LuaE e b
walkSplicing forall e. LuaError e => Pusher e Inline
pushInline forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy

-- | Walks an element of type @a@ and applies the filter to all lists of
-- 'Inline' elements.
walkInlinesStraight :: (LuaError e, Walkable [Inline] a)
                    => Filter -> a -> LuaE e a
walkInlinesStraight :: forall e a.
(LuaError e, Walkable [Inline] a) =>
Filter -> a -> LuaE e a
walkInlinesStraight = forall e a b.
(LuaError e, Walkable a b) =>
Name -> Pusher e a -> Peeker e a -> Filter -> b -> LuaE e b
walkStraight Name
"Inlines" forall e. LuaError e => Pusher e [Inline]
pushInlines forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy