{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE LambdaCase           #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.AST
   Copyright   : © 2012-2020 John MacFarlane
                 © 2017-2020 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
  ( LuaAttr (..)
  , LuaListAttributes (..)
  ) where

import Control.Applicative ((<|>))
import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
import Text.Pandoc.Definition
import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
import Text.Pandoc.Lua.Marshaling.CommonState ()

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

instance Pushable Pandoc where
  push :: Pandoc -> Lua ()
push (Pandoc Meta
meta [Block]
blocks) =
    String -> [Block] -> Meta -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Pandoc" [Block]
blocks Meta
meta

instance Peekable Pandoc where
  peek :: StackIndex -> Lua Pandoc
peek StackIndex
idx = String -> Lua Pandoc -> Lua Pandoc
forall a. String -> Lua a -> Lua a
defineHowTo String
"get Pandoc value" (Lua Pandoc -> Lua Pandoc) -> Lua Pandoc -> Lua Pandoc
forall a b. (a -> b) -> a -> b
$ do
    [Block]
blocks <- StackIndex -> String -> Lua [Block]
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"blocks"
    Meta
meta   <- StackIndex -> String -> Lua Meta
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"meta"
    Pandoc -> Lua Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> Lua Pandoc) -> Pandoc -> Lua Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks

instance Pushable Meta where
  push :: Meta -> Lua ()
push (Meta Map Text MetaValue
mmap) =
    String -> Map Text MetaValue -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Meta" Map Text MetaValue
mmap
instance Peekable Meta where
  peek :: StackIndex -> Lua Meta
peek StackIndex
idx = String -> Lua Meta -> Lua Meta
forall a. String -> Lua a -> Lua a
defineHowTo String
"get Meta value" (Lua Meta -> Lua Meta) -> Lua Meta -> Lua Meta
forall a b. (a -> b) -> a -> b
$
    Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta)
-> Lua (Map Text MetaValue) -> Lua Meta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua (Map Text MetaValue)
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx

instance Pushable MetaValue where
  push :: MetaValue -> Lua ()
push = MetaValue -> Lua ()
pushMetaValue
instance Peekable MetaValue where
  peek :: StackIndex -> Lua MetaValue
peek = StackIndex -> Lua MetaValue
peekMetaValue

instance Pushable Block where
  push :: Block -> Lua ()
push = Block -> Lua ()
pushBlock

instance Peekable Block where
  peek :: StackIndex -> Lua Block
peek = StackIndex -> Lua Block
peekBlock

-- Inline
instance Pushable Inline where
  push :: Inline -> Lua ()
push = Inline -> Lua ()
pushInline

instance Peekable Inline where
  peek :: StackIndex -> Lua Inline
peek = StackIndex -> Lua Inline
peekInline

-- Citation
instance Pushable Citation where
  push :: Citation -> Lua ()
push (Citation Text
cid [Inline]
prefix [Inline]
suffix CitationMode
mode Int
noteNum Int
hash) =
    String
-> Text
-> CitationMode
-> [Inline]
-> [Inline]
-> Int
-> Int
-> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Citation" Text
cid CitationMode
mode [Inline]
prefix [Inline]
suffix Int
noteNum Int
hash

instance Peekable Citation where
  peek :: StackIndex -> Lua Citation
peek StackIndex
idx = do
    Text
id' <- StackIndex -> String -> Lua Text
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"id"
    [Inline]
prefix <- StackIndex -> String -> Lua [Inline]
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"prefix"
    [Inline]
suffix <- StackIndex -> String -> Lua [Inline]
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"suffix"
    CitationMode
mode <- StackIndex -> String -> Lua CitationMode
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"mode"
    Int
num <- StackIndex -> String -> Lua Int
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"note_num"
    Int
hash <- StackIndex -> String -> Lua Int
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"hash"
    Citation -> Lua Citation
forall (m :: * -> *) a. Monad m => a -> m a
return (Citation -> Lua Citation) -> Citation -> Lua Citation
forall a b. (a -> b) -> a -> b
$ Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Citation Text
id' [Inline]
prefix [Inline]
suffix CitationMode
mode Int
num Int
hash

instance Pushable Alignment where
  push :: Alignment -> Lua ()
push = String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String -> Lua ()) -> (Alignment -> String) -> Alignment -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> String
forall a. Show a => a -> String
show
instance Peekable Alignment where
  peek :: StackIndex -> Lua Alignment
peek = StackIndex -> Lua Alignment
forall a. Read a => StackIndex -> Lua a
Lua.peekRead

instance Pushable CitationMode where
  push :: CitationMode -> Lua ()
push = String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String -> Lua ())
-> (CitationMode -> String) -> CitationMode -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CitationMode -> String
forall a. Show a => a -> String
show
instance Peekable CitationMode where
  peek :: StackIndex -> Lua CitationMode
peek = StackIndex -> Lua CitationMode
forall a. Read a => StackIndex -> Lua a
Lua.peekRead

instance Pushable Format where
  push :: Format -> Lua ()
push (Format Text
f) = Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Text
f
instance Peekable Format where
  peek :: StackIndex -> Lua Format
peek StackIndex
idx = Text -> Format
Format (Text -> Format) -> Lua Text -> Lua Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Text
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx

instance Pushable ListNumberDelim where
  push :: ListNumberDelim -> Lua ()
push = String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String -> Lua ())
-> (ListNumberDelim -> String) -> ListNumberDelim -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberDelim -> String
forall a. Show a => a -> String
show
instance Peekable ListNumberDelim where
  peek :: StackIndex -> Lua ListNumberDelim
peek = StackIndex -> Lua ListNumberDelim
forall a. Read a => StackIndex -> Lua a
Lua.peekRead

instance Pushable ListNumberStyle where
  push :: ListNumberStyle -> Lua ()
push = String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String -> Lua ())
-> (ListNumberStyle -> String) -> ListNumberStyle -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberStyle -> String
forall a. Show a => a -> String
show
instance Peekable ListNumberStyle where
  peek :: StackIndex -> Lua ListNumberStyle
peek = StackIndex -> Lua ListNumberStyle
forall a. Read a => StackIndex -> Lua a
Lua.peekRead

instance Pushable MathType where
  push :: MathType -> Lua ()
push = String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String -> Lua ()) -> (MathType -> String) -> MathType -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> String
forall a. Show a => a -> String
show
instance Peekable MathType where
  peek :: StackIndex -> Lua MathType
peek = StackIndex -> Lua MathType
forall a. Read a => StackIndex -> Lua a
Lua.peekRead

instance Pushable QuoteType where
  push :: QuoteType -> Lua ()
push = String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String -> Lua ()) -> (QuoteType -> String) -> QuoteType -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteType -> String
forall a. Show a => a -> String
show
instance Peekable QuoteType where
  peek :: StackIndex -> Lua QuoteType
peek = StackIndex -> Lua QuoteType
forall a. Read a => StackIndex -> Lua a
Lua.peekRead

-- | Push an meta value element to the top of the lua stack.
pushMetaValue :: MetaValue -> Lua ()
pushMetaValue :: MetaValue -> Lua ()
pushMetaValue = \case
  MetaBlocks [Block]
blcks  -> String -> [Block] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"MetaBlocks" [Block]
blcks
  MetaBool Bool
bool     -> Bool -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Bool
bool
  MetaInlines [Inline]
inlns -> String -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"MetaInlines" [Inline]
inlns
  MetaList [MetaValue]
metalist -> String -> [MetaValue] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"MetaList" [MetaValue]
metalist
  MetaMap Map Text MetaValue
metamap   -> String -> Map Text MetaValue -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"MetaMap" Map Text MetaValue
metamap
  MetaString Text
str    -> Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Text
str

-- | Interpret the value at the given stack index as meta value.
peekMetaValue :: StackIndex -> Lua MetaValue
peekMetaValue :: StackIndex -> Lua MetaValue
peekMetaValue StackIndex
idx = String -> Lua MetaValue -> Lua MetaValue
forall a. String -> Lua a -> Lua a
defineHowTo String
"get MetaValue" (Lua MetaValue -> Lua MetaValue) -> Lua MetaValue -> Lua MetaValue
forall a b. (a -> b) -> a -> b
$ do
  -- Get the contents of an AST element.
  let elementContent :: Peekable a => Lua a
      elementContent :: Lua a
elementContent = StackIndex -> Lua a
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
  Type
luatype <- StackIndex -> Lua Type
Lua.ltype StackIndex
idx
  case Type
luatype of
    Type
Lua.TypeBoolean -> Bool -> MetaValue
MetaBool (Bool -> MetaValue) -> Lua Bool -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Bool
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
    Type
Lua.TypeString  -> Text -> MetaValue
MetaString (Text -> MetaValue) -> Lua Text -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Text
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
    Type
Lua.TypeTable   -> do
      Either Exception String
tag <- Lua String -> Lua (Either Exception String)
forall a. Lua a -> Lua (Either Exception a)
Lua.try (Lua String -> Lua (Either Exception String))
-> Lua String -> Lua (Either Exception String)
forall a b. (a -> b) -> a -> b
$ StackIndex -> Lua String
LuaUtil.getTag StackIndex
idx
      case Either Exception String
tag of
        Right String
"MetaBlocks"  -> [Block] -> MetaValue
MetaBlocks  ([Block] -> MetaValue) -> Lua [Block] -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Block]
forall a. Peekable a => Lua a
elementContent
        Right String
"MetaBool"    -> Bool -> MetaValue
MetaBool    (Bool -> MetaValue) -> Lua Bool -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua Bool
forall a. Peekable a => Lua a
elementContent
        Right String
"MetaMap"     -> Map Text MetaValue -> MetaValue
MetaMap     (Map Text MetaValue -> MetaValue)
-> Lua (Map Text MetaValue) -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (Map Text MetaValue)
forall a. Peekable a => Lua a
elementContent
        Right String
"MetaInlines" -> [Inline] -> MetaValue
MetaInlines ([Inline] -> MetaValue) -> Lua [Inline] -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Inline]
forall a. Peekable a => Lua a
elementContent
        Right String
"MetaList"    -> [MetaValue] -> MetaValue
MetaList    ([MetaValue] -> MetaValue) -> Lua [MetaValue] -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [MetaValue]
forall a. Peekable a => Lua a
elementContent
        Right String
"MetaString"  -> Text -> MetaValue
MetaString  (Text -> MetaValue) -> Lua Text -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua Text
forall a. Peekable a => Lua a
elementContent
        Right String
t             -> String -> Lua MetaValue
forall a. String -> Lua a
Lua.throwException (String
"Unknown meta tag: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
t)
        Left Exception
_ -> do
          -- no meta value tag given, try to guess.
          Int
len <- StackIndex -> Lua 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)
-> Lua (Map Text MetaValue) -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua (Map Text MetaValue)
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
            else  ([Inline] -> MetaValue
MetaInlines ([Inline] -> MetaValue) -> Lua [Inline] -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua [Inline]
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
                  Lua MetaValue -> Lua MetaValue -> Lua MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Block] -> MetaValue
MetaBlocks ([Block] -> MetaValue) -> Lua [Block] -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua [Block]
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
                  Lua MetaValue -> Lua MetaValue -> Lua MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([MetaValue] -> MetaValue
MetaList ([MetaValue] -> MetaValue) -> Lua [MetaValue] -> Lua MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua [MetaValue]
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
    Type
_        -> String -> Lua MetaValue
forall a. String -> Lua a
Lua.throwException String
"could not get meta value"

-- | Push an block element to the top of the lua stack.
pushBlock :: Block -> Lua ()
pushBlock :: Block -> Lua ()
pushBlock = \case
  BlockQuote [Block]
blcks         -> String -> [Block] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"BlockQuote" [Block]
blcks
  BulletList [[Block]]
items         -> String -> [[Block]] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"BulletList" [[Block]]
items
  CodeBlock Attr
attr Text
code      -> String -> Text -> LuaAttr -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"CodeBlock" Text
code (Attr -> LuaAttr
LuaAttr Attr
attr)
  DefinitionList [([Inline], [[Block]])]
items     -> String -> [([Inline], [[Block]])] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"DefinitionList" [([Inline], [[Block]])]
items
  Div Attr
attr [Block]
blcks           -> String -> [Block] -> LuaAttr -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Div" [Block]
blcks (Attr -> LuaAttr
LuaAttr Attr
attr)
  Header Int
lvl Attr
attr [Inline]
inlns    -> String -> Int -> [Inline] -> LuaAttr -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Header" Int
lvl [Inline]
inlns (Attr -> LuaAttr
LuaAttr Attr
attr)
  Block
HorizontalRule           -> String -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"HorizontalRule"
  LineBlock [[Inline]]
blcks          -> String -> [[Inline]] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"LineBlock" [[Inline]]
blcks
  OrderedList ListAttributes
lstAttr [[Block]]
list -> String -> [[Block]] -> LuaListAttributes -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"OrderedList" [[Block]]
list
                                                 (ListAttributes -> LuaListAttributes
LuaListAttributes ListAttributes
lstAttr)
  Block
Null                     -> String -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Null"
  Para [Inline]
blcks               -> String -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Para" [Inline]
blcks
  Plain [Inline]
blcks              -> String -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Plain" [Inline]
blcks
  RawBlock Format
f Text
cs            -> String -> Format -> Text -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"RawBlock" Format
f Text
cs
  Table [Inline]
capt [Alignment]
aligns [Double]
widths [[Block]]
headers [[[Block]]]
rows ->
    String
-> [Inline]
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Table" [Inline]
capt [Alignment]
aligns [Double]
widths [[Block]]
headers [[[Block]]]
rows

-- | Return the value at the given index as block if possible.
peekBlock :: StackIndex -> Lua Block
peekBlock :: StackIndex -> Lua Block
peekBlock StackIndex
idx = String -> Lua Block -> Lua Block
forall a. String -> Lua a -> Lua a
defineHowTo String
"get Block value" (Lua Block -> Lua Block) -> Lua Block -> Lua Block
forall a b. (a -> b) -> a -> b
$ do
  String
tag <- StackIndex -> Lua String
LuaUtil.getTag StackIndex
idx
  case String
tag of
      String
"BlockQuote"     -> [Block] -> Block
BlockQuote ([Block] -> Block) -> Lua [Block] -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Block]
forall a. Peekable a => Lua a
elementContent
      String
"BulletList"     -> [[Block]] -> Block
BulletList ([[Block]] -> Block) -> Lua [[Block]] -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [[Block]]
forall a. Peekable a => Lua a
elementContent
      String
"CodeBlock"      -> (Attr -> Text -> Block) -> (LuaAttr, Text) -> Block
forall a b. (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr Attr -> Text -> Block
CodeBlock ((LuaAttr, Text) -> Block) -> Lua (LuaAttr, Text) -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (LuaAttr, Text)
forall a. Peekable a => Lua a
elementContent
      String
"DefinitionList" -> [([Inline], [[Block]])] -> Block
DefinitionList ([([Inline], [[Block]])] -> Block)
-> Lua [([Inline], [[Block]])] -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [([Inline], [[Block]])]
forall a. Peekable a => Lua a
elementContent
      String
"Div"            -> (Attr -> [Block] -> Block) -> (LuaAttr, [Block]) -> Block
forall a b. (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr Attr -> [Block] -> Block
Div ((LuaAttr, [Block]) -> Block)
-> Lua (LuaAttr, [Block]) -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (LuaAttr, [Block])
forall a. Peekable a => Lua a
elementContent
      String
"Header"         -> (\(Int
lvl, LuaAttr Attr
attr, [Inline]
lst) -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr [Inline]
lst)
                          ((Int, LuaAttr, [Inline]) -> Block)
-> Lua (Int, LuaAttr, [Inline]) -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (Int, LuaAttr, [Inline])
forall a. Peekable a => Lua a
elementContent
      String
"HorizontalRule" -> Block -> Lua Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
HorizontalRule
      String
"LineBlock"      -> [[Inline]] -> Block
LineBlock ([[Inline]] -> Block) -> Lua [[Inline]] -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [[Inline]]
forall a. Peekable a => Lua a
elementContent
      String
"OrderedList"    -> (\(LuaListAttributes ListAttributes
lstAttr, [[Block]]
lst) ->
                             ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
lstAttr [[Block]]
lst)
                          ((LuaListAttributes, [[Block]]) -> Block)
-> Lua (LuaListAttributes, [[Block]]) -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (LuaListAttributes, [[Block]])
forall a. Peekable a => Lua a
elementContent
      String
"Null"           -> Block -> Lua Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
Null
      String
"Para"           -> [Inline] -> Block
Para ([Inline] -> Block) -> Lua [Inline] -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Inline]
forall a. Peekable a => Lua a
elementContent
      String
"Plain"          -> [Inline] -> Block
Plain ([Inline] -> Block) -> Lua [Inline] -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Inline]
forall a. Peekable a => Lua a
elementContent
      String
"RawBlock"       -> (Format -> Text -> Block) -> (Format, Text) -> Block
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Format -> Text -> Block
RawBlock ((Format, Text) -> Block) -> Lua (Format, Text) -> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (Format, Text)
forall a. Peekable a => Lua a
elementContent
      String
"Table"          -> (\([Inline]
capt, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
body) ->
                                  [Inline]
-> [Alignment] -> [Double] -> [[Block]] -> [[[Block]]] -> Block
Table [Inline]
capt [Alignment]
aligns [Double]
widths [[Block]]
headers [[[Block]]]
body)
                          (([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
 -> Block)
-> Lua ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
-> Lua Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
forall a. Peekable a => Lua a
elementContent
      String
_ -> String -> Lua Block
forall a. String -> Lua a
Lua.throwException (String
"Unknown block type: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tag)
 where
   -- Get the contents of an AST element.
   elementContent :: Peekable a => Lua a
   elementContent :: Lua a
elementContent = StackIndex -> String -> Lua a
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"c"

-- | Push an inline element to the top of the lua stack.
pushInline :: Inline -> Lua ()
pushInline :: Inline -> Lua ()
pushInline = \case
  Cite [Citation]
citations [Inline]
lst       -> String -> [Inline] -> [Citation] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Cite" [Inline]
lst [Citation]
citations
  Code Attr
attr Text
lst            -> String -> Text -> LuaAttr -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Code" Text
lst (Attr -> LuaAttr
LuaAttr Attr
attr)
  Emph [Inline]
inlns               -> String -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Emph" [Inline]
inlns
  Image Attr
attr [Inline]
alt (Text
src,Text
tit) -> String -> [Inline] -> Text -> Text -> LuaAttr -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Image" [Inline]
alt Text
src Text
tit (Attr -> LuaAttr
LuaAttr Attr
attr)
  Inline
LineBreak                -> String -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"LineBreak"
  Link Attr
attr [Inline]
lst (Text
src,Text
tit)  -> String -> [Inline] -> Text -> Text -> LuaAttr -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Link" [Inline]
lst Text
src Text
tit (Attr -> LuaAttr
LuaAttr Attr
attr)
  Note [Block]
blcks               -> String -> [Block] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Note" [Block]
blcks
  Math MathType
mty Text
str             -> String -> MathType -> Text -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Math" MathType
mty Text
str
  Quoted QuoteType
qt [Inline]
inlns          -> String -> QuoteType -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Quoted" QuoteType
qt [Inline]
inlns
  RawInline Format
f Text
cs           -> String -> Format -> Text -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"RawInline" Format
f Text
cs
  SmallCaps [Inline]
inlns          -> String -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"SmallCaps" [Inline]
inlns
  Inline
SoftBreak                -> String -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"SoftBreak"
  Inline
Space                    -> String -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Space"
  Span Attr
attr [Inline]
inlns          -> String -> [Inline] -> LuaAttr -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Span" [Inline]
inlns (Attr -> LuaAttr
LuaAttr Attr
attr)
  Str Text
str                  -> String -> Text -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Str" Text
str
  Strikeout [Inline]
inlns          -> String -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Strikeout" [Inline]
inlns
  Strong [Inline]
inlns             -> String -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Strong" [Inline]
inlns
  Subscript [Inline]
inlns          -> String -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Subscript" [Inline]
inlns
  Superscript [Inline]
inlns        -> String -> [Inline] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Superscript" [Inline]
inlns

-- | Return the value at the given index as inline if possible.
peekInline :: StackIndex -> Lua Inline
peekInline :: StackIndex -> Lua Inline
peekInline StackIndex
idx = String -> Lua Inline -> Lua Inline
forall a. String -> Lua a -> Lua a
defineHowTo String
"get Inline value" (Lua Inline -> Lua Inline) -> Lua Inline -> Lua Inline
forall a b. (a -> b) -> a -> b
$ do
  String
tag <- StackIndex -> Lua String
LuaUtil.getTag StackIndex
idx
  case String
tag of
    String
"Cite"       -> ([Citation] -> [Inline] -> Inline)
-> ([Citation], [Inline]) -> Inline
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Citation] -> [Inline] -> Inline
Cite (([Citation], [Inline]) -> Inline)
-> Lua ([Citation], [Inline]) -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua ([Citation], [Inline])
forall a. Peekable a => Lua a
elementContent
    String
"Code"       -> (Attr -> Text -> Inline) -> (LuaAttr, Text) -> Inline
forall a b. (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr Attr -> Text -> Inline
Code ((LuaAttr, Text) -> Inline) -> Lua (LuaAttr, Text) -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (LuaAttr, Text)
forall a. Peekable a => Lua a
elementContent
    String
"Emph"       -> [Inline] -> Inline
Emph ([Inline] -> Inline) -> Lua [Inline] -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Inline]
forall a. Peekable a => Lua a
elementContent
    String
"Image"      -> (\(LuaAttr Attr
attr, [Inline]
lst, (Text, Text)
tgt) -> Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lst (Text, Text)
tgt)
                    ((LuaAttr, [Inline], (Text, Text)) -> Inline)
-> Lua (LuaAttr, [Inline], (Text, Text)) -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (LuaAttr, [Inline], (Text, Text))
forall a. Peekable a => Lua a
elementContent
    String
"Link"       -> (\(LuaAttr Attr
attr, [Inline]
lst, (Text, Text)
tgt) -> Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
lst (Text, Text)
tgt)
                    ((LuaAttr, [Inline], (Text, Text)) -> Inline)
-> Lua (LuaAttr, [Inline], (Text, Text)) -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (LuaAttr, [Inline], (Text, Text))
forall a. Peekable a => Lua a
elementContent
    String
"LineBreak"  -> Inline -> Lua Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
LineBreak
    String
"Note"       -> [Block] -> Inline
Note ([Block] -> Inline) -> Lua [Block] -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Block]
forall a. Peekable a => Lua a
elementContent
    String
"Math"       -> (MathType -> Text -> Inline) -> (MathType, Text) -> Inline
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MathType -> Text -> Inline
Math ((MathType, Text) -> Inline) -> Lua (MathType, Text) -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (MathType, Text)
forall a. Peekable a => Lua a
elementContent
    String
"Quoted"     -> (QuoteType -> [Inline] -> Inline)
-> (QuoteType, [Inline]) -> Inline
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry QuoteType -> [Inline] -> Inline
Quoted ((QuoteType, [Inline]) -> Inline)
-> Lua (QuoteType, [Inline]) -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (QuoteType, [Inline])
forall a. Peekable a => Lua a
elementContent
    String
"RawInline"  -> (Format -> Text -> Inline) -> (Format, Text) -> Inline
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Format -> Text -> Inline
RawInline ((Format, Text) -> Inline) -> Lua (Format, Text) -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (Format, Text)
forall a. Peekable a => Lua a
elementContent
    String
"SmallCaps"  -> [Inline] -> Inline
SmallCaps ([Inline] -> Inline) -> Lua [Inline] -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Inline]
forall a. Peekable a => Lua a
elementContent
    String
"SoftBreak"  -> Inline -> Lua Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
SoftBreak
    String
"Space"      -> Inline -> Lua Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
Space
    String
"Span"       -> (Attr -> [Inline] -> Inline) -> (LuaAttr, [Inline]) -> Inline
forall a b. (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr Attr -> [Inline] -> Inline
Span ((LuaAttr, [Inline]) -> Inline)
-> Lua (LuaAttr, [Inline]) -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (LuaAttr, [Inline])
forall a. Peekable a => Lua a
elementContent
    String
"Str"        -> Text -> Inline
Str (Text -> Inline) -> Lua Text -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua Text
forall a. Peekable a => Lua a
elementContent
    String
"Strikeout"  -> [Inline] -> Inline
Strikeout ([Inline] -> Inline) -> Lua [Inline] -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Inline]
forall a. Peekable a => Lua a
elementContent
    String
"Strong"     -> [Inline] -> Inline
Strong ([Inline] -> Inline) -> Lua [Inline] -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Inline]
forall a. Peekable a => Lua a
elementContent
    String
"Subscript"  -> [Inline] -> Inline
Subscript ([Inline] -> Inline) -> Lua [Inline] -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Inline]
forall a. Peekable a => Lua a
elementContent
    String
"Superscript"-> [Inline] -> Inline
Superscript ([Inline] -> Inline) -> Lua [Inline] -> Lua Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [Inline]
forall a. Peekable a => Lua a
elementContent
    String
_ -> String -> Lua Inline
forall a. String -> Lua a
Lua.throwException (String
"Unknown inline type: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tag)
 where
   -- Get the contents of an AST element.
   elementContent :: Peekable a => Lua a
   elementContent :: Lua a
elementContent = StackIndex -> String -> Lua a
forall a. Peekable a => StackIndex -> String -> Lua a
LuaUtil.rawField StackIndex
idx String
"c"

withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr Attr -> a -> b
f (LuaAttr
attributes, a
x) = Attr -> a -> b
f (LuaAttr -> Attr
fromLuaAttr LuaAttr
attributes) a
x

-- | Wrapper for Attr
newtype LuaAttr = LuaAttr { LuaAttr -> Attr
fromLuaAttr :: Attr }

instance Pushable LuaAttr where
  push :: LuaAttr -> Lua ()
push (LuaAttr (Text
id', [Text]
classes, [(Text, Text)]
kv)) =
    String -> Text -> [Text] -> [(Text, Text)] -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"Attr" Text
id' [Text]
classes [(Text, Text)]
kv

instance Peekable LuaAttr where
  peek :: StackIndex -> Lua LuaAttr
peek StackIndex
idx = String -> Lua LuaAttr -> Lua LuaAttr
forall a. String -> Lua a -> Lua a
defineHowTo String
"get Attr value" (Attr -> LuaAttr
LuaAttr (Attr -> LuaAttr) -> Lua Attr -> Lua LuaAttr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Attr
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)

-- | Wrapper for ListAttributes
newtype LuaListAttributes = LuaListAttributes  ListAttributes

instance Pushable LuaListAttributes where
  push :: LuaListAttributes -> Lua ()
push (LuaListAttributes (Int
start, ListNumberStyle
style, ListNumberDelim
delimiter)) =
    String -> Int -> ListNumberStyle -> ListNumberDelim -> Lua ()
forall a. PushViaCall a => String -> a
pushViaConstructor String
"ListAttributes" Int
start ListNumberStyle
style ListNumberDelim
delimiter

instance Peekable LuaListAttributes where
  peek :: StackIndex -> Lua LuaListAttributes
peek = String -> Lua LuaListAttributes -> Lua LuaListAttributes
forall a. String -> Lua a -> Lua a
defineHowTo String
"get ListAttributes value" (Lua LuaListAttributes -> Lua LuaListAttributes)
-> (StackIndex -> Lua LuaListAttributes)
-> StackIndex
-> Lua LuaListAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (ListAttributes -> LuaListAttributes)
-> Lua ListAttributes -> Lua LuaListAttributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListAttributes -> LuaListAttributes
LuaListAttributes (Lua ListAttributes -> Lua LuaListAttributes)
-> (StackIndex -> Lua ListAttributes)
-> StackIndex
-> Lua LuaListAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Lua ListAttributes
forall a. Peekable a => StackIndex -> Lua a
Lua.peek