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

Defines a helper type that can handle different types of 'Block' and
'Inline' element contents.
-}
module Text.Pandoc.Lua.Marshal.Content
  ( Content (..)
  , contentTypeDescription
  , peekContent
  , pushContent
  , peekDefinitionItem
  ) where

import Control.Applicative ((<|>))
import Control.Monad ((<$!>))
import HsLua
import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block
  ( peekBlocksFuzzy, pushBlocks )
import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline
  ( peekInlinesFuzzy, pushInlines )
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Definition (Inline, Block)

--
-- Content
--

-- | 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]]

-- | Gets the text property of an Inline, if present.
contentTypeDescription :: Content -> String
contentTypeDescription :: Content -> String
contentTypeDescription = \case
  ContentBlocks {}    -> String
"list of Block items"
  ContentInlines {}   -> String
"list of Inline items"
  ContentLines {}     -> String
"list of Inline lists (i.e., a list of lines)"
  ContentDefItems {}  -> String
"list of definition items items"
  ContentListItems {} -> String
"list items (i.e., list of list of Block elements)"

-- | Pushes the 'Content' to the stack.
pushContent :: LuaError e => Pusher e Content
pushContent :: forall e. LuaError e => Pusher e Content
pushContent = \case
  ContentBlocks [Block]
blks    -> forall e. LuaError e => Pusher e [Block]
pushBlocks [Block]
blks
  ContentInlines [Inline]
inlns  -> forall e. LuaError e => Pusher e [Inline]
pushInlines [Inline]
inlns
  ContentLines [[Inline]]
lns      -> forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList forall e. LuaError e => Pusher e [Inline]
pushInlines [[Inline]]
lns
  ContentDefItems [([Inline], [[Block]])]
itms  -> forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList forall e. LuaError e => Pusher e ([Inline], [[Block]])
pushDefinitionItem [([Inline], [[Block]])]
itms
  ContentListItems [[Block]]
itms -> forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList forall e. LuaError e => Pusher e [Block]
pushBlocks [[Block]]
itms

-- | Gets a 'Content' element from the stack.
peekContent :: LuaError e => Peeker e Content
peekContent :: forall e. LuaError e => Peeker e Content
peekContent StackIndex
idx =
  ([Inline] -> Content
ContentInlines forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy StackIndex
idx) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ([[Inline]] -> Content
ContentLines  forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy StackIndex
idx) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ([Block] -> Content
ContentBlocks  forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ([[Block]] -> Content
ContentListItems forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ([([Inline], [[Block]])] -> Content
ContentDefItems  forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem StackIndex
idx)

-- | Retrieves a single definition item from 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 :: forall e. LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem = forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy forall a b. (a -> b) -> a -> b
$ forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
  [ forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy
  , \StackIndex
idx -> (forall a. a -> [a] -> [a]
:[]) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx
  ]

-- | Pushes a single definition items on the stack.
pushDefinitionItem :: LuaError e => Pusher e ([Inline], [[Block]])
pushDefinitionItem :: forall e. LuaError e => Pusher e ([Inline], [[Block]])
pushDefinitionItem = forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair forall e. LuaError e => Pusher e [Inline]
pushInlines
                              (forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList forall e. LuaError e => Pusher e [Block]
pushBlocks)