{-# 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
  ( pushSources
  ) where

import Data.Text (Text)
import HsLua as Lua
import Text.Pandoc.Lua.Marshal.List (newListMetatable)
import Text.Pandoc.Sources (Sources (..))
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
  Pusher e (SourcePos, Text) -> [(SourcePos, Text)] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList (UDTypeWithList e (DocumentedFunction e) (SourcePos, Text) Void
-> Pusher e (SourcePos, Text)
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) (SourcePos, Text) Void
forall e. LuaError e => DocumentedType e (SourcePos, Text)
typeSource) [(SourcePos, Text)]
srcs
  Name -> LuaE e () -> LuaE e ()
forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
"pandoc Sources" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__tostring"
    HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (HaskellFunction e -> LuaE e ()) -> HaskellFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
      [(SourcePos, Text)]
sources <- Peek e [(SourcePos, Text)] -> LuaE e [(SourcePos, Text)]
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e [(SourcePos, Text)] -> LuaE e [(SourcePos, Text)])
-> Peek e [(SourcePos, Text)] -> LuaE e [(SourcePos, Text)]
forall a b. (a -> b) -> a -> b
$ Peeker e (SourcePos, Text) -> Peeker e [(SourcePos, Text)]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList (UDTypeWithList e (DocumentedFunction e) (SourcePos, Text) Void
-> Peeker e (SourcePos, Text)
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) (SourcePos, Text) Void
forall e. LuaError e => DocumentedType e (SourcePos, Text)
typeSource) (CInt -> StackIndex
nthBottom CInt
1)
      Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> ([Text] -> Text) -> [Text] -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> LuaE e ()) -> [Text] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ((SourcePos, Text) -> Text) -> [(SourcePos, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SourcePos, Text) -> Text
forall a b. (a, b) -> b
snd [(SourcePos, Text)]
sources
      NumResults -> HaskellFunction e
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)

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