{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module      : Text.Pandoc.Lua.Marshaling.Sources
Copyright   : © 2021-2022 Albert Krewinkel
License     : GNU GPL, version 2 or above
Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Marshal 'Sources'.
-}
module Text.Pandoc.Lua.Marshal.Sources
  ( peekSources
  , pushSources
  ) where

import Control.Monad ((<$!>))
import Data.Text (Text)
import HsLua as Lua
import Text.Pandoc.Lua.Marshal.List (newListMetatable)
import Text.Pandoc.Sources (Sources (..), toSources)
import Text.Parsec (SourcePos, sourceName)

-- | Pushes the 'Sources' as a list of lazy Lua objects.
pushSources :: LuaError e => Pusher e Sources
pushSources :: forall e. LuaError e => Pusher e Sources
pushSources (Sources [(SourcePos, Text)]
srcs) = do
  forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList (forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e (SourcePos, Text)
typeSource) [(SourcePos, Text)]
srcs
  forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
"pandoc Sources" forall a b. (a -> b) -> a -> b
$ do
    forall e. Name -> LuaE e ()
pushName Name
"__tostring"
    forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction forall a b. (a -> b) -> a -> b
$ do
      [(SourcePos, Text)]
sources <- forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList (forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e (SourcePos, Text)
typeSource) (CInt -> StackIndex
nthBottom CInt
1)
      forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(SourcePos, Text)]
sources
      forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
    forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)

-- | Retrieves sources from the stack.
peekSources :: LuaError e => Peeker e Sources
peekSources :: forall e. LuaError e => Peeker e Sources
peekSources 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. ToSources a => a -> Sources
toSources forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. Peeker e Text
peekText StackIndex
idx
  Type
TypeTable  -> [(SourcePos, Text)] -> Sources
Sources 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 fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e (SourcePos, Text)
typeSource) StackIndex
idx
  Type
_          -> [(SourcePos, Text)] -> Sources
Sources forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e (SourcePos, Text)
typeSource StackIndex
idx

-- | Source object type.
typeSource :: LuaError e => DocumentedType e (SourcePos, Text)
typeSource :: forall e. LuaError e => DocumentedType e (SourcePos, Text)
typeSource = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"pandoc input source"
  [ 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 snd
    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 (SourcePos, Text)
typeSource Text
"srcs" Text
"Source to print in native format"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. Pusher e Text
pushText Text
"string" Text
"Haskell representation"
  ]
  [ forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"name" Text
"source name"
      (forall e. String -> LuaE e ()
pushString, SourcePos -> String
sourceName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
  , forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"text" Text
"source text"
      (forall e. Pusher e Text
pushText, forall a b. (a, b) -> b
snd)
  ]