aboutsummaryrefslogtreecommitdiff
path: root/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Sources.hs
blob: 902c127f276f135e2a644c81aacca92c7d956132 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module      : Text.Pandoc.Lua.Marshaling.Sources
Copyright   : © 2021-2024 Albert Krewinkel
License     : GNU GPL, version 2 or above
Maintainer  : Albert Krewinkel <[email protected]>

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 (Sources srcs) = do
  pushList (pushUD typeSource) srcs
  newListMetatable "Sources" $ do
    pushName "__tostring"
    pushHaskellFunction $ do
      sources <- forcePeek $ peekList (peekUD typeSource) (nthBottom 1)
      pushText . mconcat $ map snd sources
      return 1
    rawset (nth 3)
  setmetatable (nth 2)

-- | Retrieves sources from the stack.
peekSources :: LuaError e => Peeker e Sources
peekSources idx = liftLua (ltype idx) >>= \case
  TypeString -> toSources <$!> peekText idx
  TypeTable  -> Sources <$!> peekList (peekUD typeSource) idx
  _          -> Sources . (:[]) <$!> peekUD typeSource idx

-- | Source object type.
typeSource :: LuaError e => DocumentedType e (SourcePos, Text)
typeSource = deftype "Source"
  [ operation Tostring $ lambda
    ### liftPure snd
    <#> udparam typeSource "srcs" "Source to print in native format"
    =#> functionResult pushText "string" "Haskell representation"
  ]
  [ readonly "name" "source name"
      (pushString, sourceName . fst)
  , readonly "text" "source text"
      (pushText, snd)
  ]