aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Lua/Marshaling
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Lua/Marshaling')
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/AST.hs378
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/AnyValue.hs24
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/CommonState.hs102
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/Context.hs28
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/List.hs43
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/MediaBag.hs73
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/PandocError.hs65
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs79
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs59
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/Version.hs154
10 files changed, 0 insertions, 1005 deletions
diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
deleted file mode 100644
index 8e12d232c..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ /dev/null
@@ -1,378 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{- |
- Module : Text.Pandoc.Lua.Marshaling.AST
- Copyright : © 2012-2021 John MacFarlane
- © 2017-2021 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 Control.Monad ((<$!>))
-import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
-import Text.Pandoc.Definition
-import Text.Pandoc.Error (PandocError)
-import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
-import Text.Pandoc.Lua.Marshaling.CommonState ()
-
-import qualified Control.Monad.Catch as Catch
-import qualified Foreign.Lua as Lua
-import qualified Text.Pandoc.Lua.Util as LuaUtil
-
-instance Pushable Pandoc where
- push (Pandoc meta blocks) =
- pushViaConstructor "Pandoc" blocks meta
-
-instance Peekable Pandoc where
- peek idx = defineHowTo "get Pandoc value" $! Pandoc
- <$!> LuaUtil.rawField idx "meta"
- <*> LuaUtil.rawField idx "blocks"
-
-instance Pushable Meta where
- push (Meta mmap) =
- pushViaConstructor "Meta" mmap
-instance Peekable Meta where
- peek idx = defineHowTo "get Meta value" $!
- Meta <$!> Lua.peek idx
-
-instance Pushable MetaValue where
- push = pushMetaValue
-instance Peekable MetaValue where
- peek = peekMetaValue
-
-instance Pushable Block where
- push = pushBlock
-
-instance Peekable Block where
- peek = peekBlock
-
--- Inline
-instance Pushable Inline where
- push = pushInline
-
-instance Peekable Inline where
- peek = peekInline
-
--- Citation
-instance Pushable Citation where
- push (Citation cid prefix suffix mode noteNum hash) =
- pushViaConstructor "Citation" cid mode prefix suffix noteNum hash
-
-instance Peekable Citation where
- peek idx = Citation
- <$!> LuaUtil.rawField idx "id"
- <*> LuaUtil.rawField idx "prefix"
- <*> LuaUtil.rawField idx "suffix"
- <*> LuaUtil.rawField idx "mode"
- <*> LuaUtil.rawField idx "note_num"
- <*> LuaUtil.rawField idx "hash"
-
-instance Pushable Alignment where
- push = Lua.push . show
-instance Peekable Alignment where
- peek = Lua.peekRead
-
-instance Pushable CitationMode where
- push = Lua.push . show
-instance Peekable CitationMode where
- peek = Lua.peekRead
-
-instance Pushable Format where
- push (Format f) = Lua.push f
-instance Peekable Format where
- peek idx = Format <$!> Lua.peek idx
-
-instance Pushable ListNumberDelim where
- push = Lua.push . show
-instance Peekable ListNumberDelim where
- peek = Lua.peekRead
-
-instance Pushable ListNumberStyle where
- push = Lua.push . show
-instance Peekable ListNumberStyle where
- peek = Lua.peekRead
-
-instance Pushable MathType where
- push = Lua.push . show
-instance Peekable MathType where
- peek = Lua.peekRead
-
-instance Pushable QuoteType where
- push = Lua.push . show
-instance Peekable QuoteType where
- peek = Lua.peekRead
-
--- | Push an meta value element to the top of the lua stack.
-pushMetaValue :: MetaValue -> Lua ()
-pushMetaValue = \case
- MetaBlocks blcks -> pushViaConstructor "MetaBlocks" blcks
- MetaBool bool -> Lua.push bool
- MetaInlines inlns -> pushViaConstructor "MetaInlines" inlns
- MetaList metalist -> pushViaConstructor "MetaList" metalist
- MetaMap metamap -> pushViaConstructor "MetaMap" metamap
- MetaString str -> Lua.push str
-
--- | Interpret the value at the given stack index as meta value.
-peekMetaValue :: StackIndex -> Lua MetaValue
-peekMetaValue idx = defineHowTo "get MetaValue" $ do
- -- Get the contents of an AST element.
- let elementContent :: Peekable a => Lua a
- elementContent = Lua.peek idx
- luatype <- Lua.ltype idx
- case luatype of
- Lua.TypeBoolean -> MetaBool <$!> Lua.peek idx
- Lua.TypeString -> MetaString <$!> Lua.peek idx
- Lua.TypeTable -> do
- tag <- try $ LuaUtil.getTag idx
- case tag of
- Right "MetaBlocks" -> MetaBlocks <$!> elementContent
- Right "MetaBool" -> MetaBool <$!> elementContent
- Right "MetaMap" -> MetaMap <$!> elementContent
- Right "MetaInlines" -> MetaInlines <$!> elementContent
- Right "MetaList" -> MetaList <$!> elementContent
- Right "MetaString" -> MetaString <$!> elementContent
- Right t -> Lua.throwMessage ("Unknown meta tag: " <> t)
- Left _ -> do
- -- no meta value tag given, try to guess.
- len <- Lua.rawlen idx
- if len <= 0
- then MetaMap <$!> Lua.peek idx
- else (MetaInlines <$!> Lua.peek idx)
- <|> (MetaBlocks <$!> Lua.peek idx)
- <|> (MetaList <$!> Lua.peek idx)
- _ -> Lua.throwMessage "could not get meta value"
-
--- | Push a block element to the top of the Lua stack.
-pushBlock :: Block -> Lua ()
-pushBlock = \case
- BlockQuote blcks -> pushViaConstructor "BlockQuote" blcks
- BulletList items -> pushViaConstructor "BulletList" items
- CodeBlock attr code -> pushViaConstructor "CodeBlock" code (LuaAttr attr)
- DefinitionList items -> pushViaConstructor "DefinitionList" items
- Div attr blcks -> pushViaConstructor "Div" blcks (LuaAttr attr)
- Header lvl attr inlns -> pushViaConstructor "Header" lvl inlns (LuaAttr attr)
- HorizontalRule -> pushViaConstructor "HorizontalRule"
- LineBlock blcks -> pushViaConstructor "LineBlock" blcks
- OrderedList lstAttr list -> pushViaConstructor "OrderedList" list
- (LuaListAttributes lstAttr)
- Null -> pushViaConstructor "Null"
- Para blcks -> pushViaConstructor "Para" blcks
- Plain blcks -> pushViaConstructor "Plain" blcks
- RawBlock f cs -> pushViaConstructor "RawBlock" f cs
- Table attr blkCapt specs thead tbody tfoot ->
- pushViaConstructor "Table" blkCapt specs thead tbody tfoot attr
-
--- | Return the value at the given index as block if possible.
-peekBlock :: StackIndex -> Lua Block
-peekBlock idx = defineHowTo "get Block value" $! do
- tag <- LuaUtil.getTag idx
- case tag of
- "BlockQuote" -> BlockQuote <$!> elementContent
- "BulletList" -> BulletList <$!> elementContent
- "CodeBlock" -> withAttr CodeBlock <$!> elementContent
- "DefinitionList" -> DefinitionList <$!> elementContent
- "Div" -> withAttr Div <$!> elementContent
- "Header" -> (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)
- <$!> elementContent
- "HorizontalRule" -> return HorizontalRule
- "LineBlock" -> LineBlock <$!> elementContent
- "OrderedList" -> (\(LuaListAttributes lstAttr, lst) ->
- OrderedList lstAttr lst)
- <$!> elementContent
- "Null" -> return Null
- "Para" -> Para <$!> elementContent
- "Plain" -> Plain <$!> elementContent
- "RawBlock" -> uncurry RawBlock <$!> elementContent
- "Table" -> (\(attr, capt, colSpecs, thead, tbodies, tfoot) ->
- Table (fromLuaAttr attr)
- capt
- colSpecs
- thead
- tbodies
- tfoot)
- <$!> elementContent
- _ -> Lua.throwMessage ("Unknown block type: " <> tag)
- where
- -- Get the contents of an AST element.
- elementContent :: Peekable a => Lua a
- elementContent = LuaUtil.rawField idx "c"
-
-instance Pushable Caption where
- push = pushCaption
-
-instance Peekable Caption where
- peek = peekCaption
-
--- | Push Caption element
-pushCaption :: Caption -> Lua ()
-pushCaption (Caption shortCaption longCaption) = do
- Lua.newtable
- LuaUtil.addField "short" (Lua.Optional shortCaption)
- LuaUtil.addField "long" longCaption
-
--- | Peek Caption element
-peekCaption :: StackIndex -> Lua Caption
-peekCaption idx = Caption
- <$!> (Lua.fromOptional <$!> LuaUtil.rawField idx "short")
- <*> LuaUtil.rawField idx "long"
-
-instance Peekable ColWidth where
- peek idx = do
- width <- Lua.fromOptional <$!> Lua.peek idx
- return $! maybe ColWidthDefault ColWidth width
-
-instance Pushable ColWidth where
- push = \case
- (ColWidth w) -> Lua.push w
- ColWidthDefault -> Lua.pushnil
-
-instance Pushable Row where
- push (Row attr cells) = Lua.push (attr, cells)
-
-instance Peekable Row where
- peek = fmap (uncurry Row) . Lua.peek
-
-instance Pushable TableBody where
- push (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do
- Lua.newtable
- LuaUtil.addField "attr" attr
- LuaUtil.addField "row_head_columns" rowHeadColumns
- LuaUtil.addField "head" head'
- LuaUtil.addField "body" body
-
-instance Peekable TableBody where
- peek idx = TableBody
- <$!> LuaUtil.rawField idx "attr"
- <*> (RowHeadColumns <$!> LuaUtil.rawField idx "row_head_columns")
- <*> LuaUtil.rawField idx "head"
- <*> LuaUtil.rawField idx "body"
-
-instance Pushable TableHead where
- push (TableHead attr rows) = Lua.push (attr, rows)
-
-instance Peekable TableHead where
- peek = fmap (uncurry TableHead) . Lua.peek
-
-instance Pushable TableFoot where
- push (TableFoot attr cells) = Lua.push (attr, cells)
-
-instance Peekable TableFoot where
- peek = fmap (uncurry TableFoot) . Lua.peek
-
-instance Pushable Cell where
- push = pushCell
-
-instance Peekable Cell where
- peek = peekCell
-
-pushCell :: Cell -> Lua ()
-pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do
- Lua.newtable
- LuaUtil.addField "attr" attr
- LuaUtil.addField "alignment" align
- LuaUtil.addField "row_span" rowSpan
- LuaUtil.addField "col_span" colSpan
- LuaUtil.addField "contents" contents
-
-peekCell :: StackIndex -> Lua Cell
-peekCell idx = Cell
- <$!> (fromLuaAttr <$!> LuaUtil.rawField idx "attr")
- <*> LuaUtil.rawField idx "alignment"
- <*> (RowSpan <$!> LuaUtil.rawField idx "row_span")
- <*> (ColSpan <$!> LuaUtil.rawField idx "col_span")
- <*> LuaUtil.rawField idx "contents"
-
--- | Push an inline element to the top of the lua stack.
-pushInline :: Inline -> Lua ()
-pushInline = \case
- Cite citations lst -> pushViaConstructor "Cite" lst citations
- Code attr lst -> pushViaConstructor "Code" lst (LuaAttr attr)
- Emph inlns -> pushViaConstructor "Emph" inlns
- Underline inlns -> pushViaConstructor "Underline" inlns
- Image attr alt (src,tit) -> pushViaConstructor "Image" alt src tit (LuaAttr attr)
- LineBreak -> pushViaConstructor "LineBreak"
- Link attr lst (src,tit) -> pushViaConstructor "Link" lst src tit (LuaAttr attr)
- Note blcks -> pushViaConstructor "Note" blcks
- Math mty str -> pushViaConstructor "Math" mty str
- Quoted qt inlns -> pushViaConstructor "Quoted" qt inlns
- RawInline f cs -> pushViaConstructor "RawInline" f cs
- SmallCaps inlns -> pushViaConstructor "SmallCaps" inlns
- SoftBreak -> pushViaConstructor "SoftBreak"
- Space -> pushViaConstructor "Space"
- Span attr inlns -> pushViaConstructor "Span" inlns (LuaAttr attr)
- Str str -> pushViaConstructor "Str" str
- Strikeout inlns -> pushViaConstructor "Strikeout" inlns
- Strong inlns -> pushViaConstructor "Strong" inlns
- Subscript inlns -> pushViaConstructor "Subscript" inlns
- Superscript inlns -> pushViaConstructor "Superscript" inlns
-
--- | Return the value at the given index as inline if possible.
-peekInline :: StackIndex -> Lua Inline
-peekInline idx = defineHowTo "get Inline value" $ do
- tag <- LuaUtil.getTag idx
- case tag of
- "Cite" -> uncurry Cite <$!> elementContent
- "Code" -> withAttr Code <$!> elementContent
- "Emph" -> Emph <$!> elementContent
- "Underline" -> Underline <$!> elementContent
- "Image" -> (\(LuaAttr !attr, !lst, !tgt) -> Image attr lst tgt)
- <$!> elementContent
- "Link" -> (\(LuaAttr !attr, !lst, !tgt) -> Link attr lst tgt)
- <$!> elementContent
- "LineBreak" -> return LineBreak
- "Note" -> Note <$!> elementContent
- "Math" -> uncurry Math <$!> elementContent
- "Quoted" -> uncurry Quoted <$!> elementContent
- "RawInline" -> uncurry RawInline <$!> elementContent
- "SmallCaps" -> SmallCaps <$!> elementContent
- "SoftBreak" -> return SoftBreak
- "Space" -> return Space
- "Span" -> withAttr Span <$!> elementContent
- -- strict to Lua string is copied before gc
- "Str" -> Str <$!> elementContent
- "Strikeout" -> Strikeout <$!> elementContent
- "Strong" -> Strong <$!> elementContent
- "Subscript" -> Subscript <$!> elementContent
- "Superscript"-> Superscript <$!> elementContent
- _ -> Lua.throwMessage ("Unknown inline type: " <> tag)
- where
- -- Get the contents of an AST element.
- elementContent :: Peekable a => Lua a
- elementContent = LuaUtil.rawField idx "c"
-
-try :: Lua a -> Lua (Either PandocError a)
-try = Catch.try
-
-withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
-withAttr f (attributes, x) = f (fromLuaAttr attributes) x
-
--- | Wrapper for Attr
-newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr }
-
-instance Pushable LuaAttr where
- push (LuaAttr (id', classes, kv)) =
- pushViaConstructor "Attr" id' classes kv
-
-instance Peekable LuaAttr where
- peek idx = defineHowTo "get Attr value" $! (LuaAttr <$!> Lua.peek idx)
-
--- | Wrapper for ListAttributes
-newtype LuaListAttributes = LuaListAttributes ListAttributes
-
-instance Pushable LuaListAttributes where
- push (LuaListAttributes (start, style, delimiter)) =
- pushViaConstructor "ListAttributes" start style delimiter
-
-instance Peekable LuaListAttributes where
- peek = defineHowTo "get ListAttributes value" .
- fmap LuaListAttributes . Lua.peek
diff --git a/src/Text/Pandoc/Lua/Marshaling/AnyValue.hs b/src/Text/Pandoc/Lua/Marshaling/AnyValue.hs
deleted file mode 100644
index 82e26b963..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/AnyValue.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{- |
- Module : Text.Pandoc.Lua.Marshaling.AnyValue
- Copyright : © 2017-2021 Albert Krewinkel
- License : GNU GPL, version 2 or above
-
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Helper type to work with raw Lua stack indices instead of unmarshaled
-values.
-
-TODO: Most of this module should be abstracted, factored out, and go
-into HsLua.
--}
-module Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..)) where
-
-import Foreign.Lua (Peekable (peek), StackIndex)
-
--- | Dummy type to allow values of arbitrary Lua type. This just wraps
--- stack indices, using it requires extra care.
-newtype AnyValue = AnyValue StackIndex
-
-instance Peekable AnyValue where
- peek = return . AnyValue
diff --git a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs b/src/Text/Pandoc/Lua/Marshaling/CommonState.hs
deleted file mode 100644
index 147197c5d..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{- |
- Module : Text.Pandoc.Lua.Marshaling.CommonState
- Copyright : © 2012-2021 John MacFarlane
- © 2017-2021 Albert Krewinkel
- License : GNU GPL, version 2 or above
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Instances to marshal (push) and unmarshal (peek) the common state.
--}
-module Text.Pandoc.Lua.Marshaling.CommonState () where
-
-import Foreign.Lua (Lua, Peekable, Pushable)
-import Foreign.Lua.Types.Peekable (reportValueOnFailure)
-import Foreign.Lua.Userdata (ensureUserdataMetatable, pushAnyWithMetatable,
- toAnyWithName)
-import Text.Pandoc.Class (CommonState (..))
-import Text.Pandoc.Logging (LogMessage, showLogMessage)
-import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))
-
-import qualified Data.Map as Map
-import qualified Data.Text as Text
-import qualified Foreign.Lua as Lua
-import qualified Text.Pandoc.Lua.Util as LuaUtil
-
--- | Name used by Lua for the @CommonState@ type.
-commonStateTypeName :: String
-commonStateTypeName = "Pandoc CommonState"
-
-instance Peekable CommonState where
- peek idx = reportValueOnFailure commonStateTypeName
- (`toAnyWithName` commonStateTypeName) idx
-
-instance Pushable CommonState where
- push st = pushAnyWithMetatable pushCommonStateMetatable st
- where
- pushCommonStateMetatable = ensureUserdataMetatable commonStateTypeName $ do
- LuaUtil.addFunction "__index" indexCommonState
- LuaUtil.addFunction "__pairs" pairsCommonState
-
-indexCommonState :: CommonState -> AnyValue -> Lua Lua.NumResults
-indexCommonState st (AnyValue idx) = Lua.ltype idx >>= \case
- Lua.TypeString -> 1 <$ (Lua.peek idx >>= pushField)
- _ -> 1 <$ Lua.pushnil
- where
- pushField :: Text.Text -> Lua ()
- pushField name = case lookup name commonStateFields of
- Just pushValue -> pushValue st
- Nothing -> Lua.pushnil
-
-pairsCommonState :: CommonState -> Lua Lua.NumResults
-pairsCommonState st = do
- Lua.pushHaskellFunction nextFn
- Lua.pushnil
- Lua.pushnil
- return 3
- where
- nextFn :: AnyValue -> AnyValue -> Lua Lua.NumResults
- nextFn _ (AnyValue idx) =
- Lua.ltype idx >>= \case
- Lua.TypeNil -> case commonStateFields of
- [] -> 2 <$ (Lua.pushnil *> Lua.pushnil)
- (key, pushValue):_ -> 2 <$ (Lua.push key *> pushValue st)
- Lua.TypeString -> do
- key <- Lua.peek idx
- case tail $ dropWhile ((/= key) . fst) commonStateFields of
- [] -> 2 <$ (Lua.pushnil *> Lua.pushnil)
- (nextKey, pushValue):_ -> 2 <$ (Lua.push nextKey *> pushValue st)
- _ -> 2 <$ (Lua.pushnil *> Lua.pushnil)
-
-commonStateFields :: [(Text.Text, CommonState -> Lua ())]
-commonStateFields =
- [ ("input_files", Lua.push . stInputFiles)
- , ("output_file", Lua.push . Lua.Optional . stOutputFile)
- , ("log", Lua.push . stLog)
- , ("request_headers", Lua.push . Map.fromList . stRequestHeaders)
- , ("resource_path", Lua.push . stResourcePath)
- , ("source_url", Lua.push . Lua.Optional . stSourceURL)
- , ("user_data_dir", Lua.push . Lua.Optional . stUserDataDir)
- , ("trace", Lua.push . stTrace)
- , ("verbosity", Lua.push . show . stVerbosity)
- ]
-
--- | Name used by Lua for the @CommonState@ type.
-logMessageTypeName :: String
-logMessageTypeName = "Pandoc LogMessage"
-
-instance Peekable LogMessage where
- peek idx = reportValueOnFailure logMessageTypeName
- (`toAnyWithName` logMessageTypeName) idx
-
-instance Pushable LogMessage where
- push msg = pushAnyWithMetatable pushLogMessageMetatable msg
- where
- pushLogMessageMetatable = ensureUserdataMetatable logMessageTypeName $
- LuaUtil.addFunction "__tostring" tostringLogMessage
-
-tostringLogMessage :: LogMessage -> Lua Text.Text
-tostringLogMessage = return . showLogMessage
diff --git a/src/Text/Pandoc/Lua/Marshaling/Context.hs b/src/Text/Pandoc/Lua/Marshaling/Context.hs
deleted file mode 100644
index 606bdcfb2..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/Context.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{- |
- Module : Text.Pandoc.Lua.Marshaling.Context
- Copyright : © 2012-2021 John MacFarlane
- © 2017-2021 Albert Krewinkel
- License : GNU GPL, version 2 or above
-
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Marshaling instance for doctemplates Context and its components.
--}
-module Text.Pandoc.Lua.Marshaling.Context () where
-
-import qualified Foreign.Lua as Lua
-import Foreign.Lua (Pushable)
-import Text.DocTemplates (Context(..), Val(..), TemplateTarget)
-import Text.DocLayout (render)
-
-instance (TemplateTarget a, Pushable a) => Pushable (Context a) where
- push (Context m) = Lua.push m
-
-instance (TemplateTarget a, Pushable a) => Pushable (Val a) where
- push NullVal = Lua.push ()
- push (BoolVal b) = Lua.push b
- push (MapVal ctx) = Lua.push ctx
- push (ListVal xs) = Lua.push xs
- push (SimpleVal d) = Lua.push $ render Nothing d
diff --git a/src/Text/Pandoc/Lua/Marshaling/List.hs b/src/Text/Pandoc/Lua/Marshaling/List.hs
deleted file mode 100644
index 0446302a1..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/List.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE UndecidableInstances #-}
-{- |
-Module : Text.Pandoc.Lua.Marshaling.List
-Copyright : © 2012-2021 John MacFarlane
- © 2017-2021 Albert Krewinkel
-License : GNU GPL, version 2 or above
-Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
-Stability : alpha
-
-Marshaling/unmarshaling instances for @pandoc.List@s.
--}
-module Text.Pandoc.Lua.Marshaling.List
- ( List (..)
- ) where
-
-import Data.Data (Data)
-import Foreign.Lua (Peekable, Pushable)
-import Text.Pandoc.Walk (Walkable (..))
-import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
-
-import qualified Foreign.Lua as Lua
-
--- | List wrapper which is marshalled as @pandoc.List@.
-newtype List a = List { fromList :: [a] }
- deriving (Data, Eq, Show)
-
-instance Pushable a => Pushable (List a) where
- push (List xs) =
- pushViaConstructor "List" xs
-
-instance Peekable a => Peekable (List a) where
- peek idx = defineHowTo "get List" $ do
- xs <- Lua.peek idx
- return $ List xs
-
--- List is just a wrapper, so we can reuse the walk instance for
--- unwrapped Hasekll lists.
-instance Walkable [a] b => Walkable (List a) b where
- walkM f = walkM (fmap fromList . f . List)
- query f = query (f . List)
diff --git a/src/Text/Pandoc/Lua/Marshaling/MediaBag.hs b/src/Text/Pandoc/Lua/Marshaling/MediaBag.hs
deleted file mode 100644
index 70bd010a0..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/MediaBag.hs
+++ /dev/null
@@ -1,73 +0,0 @@
-{- |
- Module : Text.Pandoc.Lua.Marshaling.MediaBag
- Copyright : © 2012-2021 John MacFarlane
- © 2017-2021 Albert Krewinkel
- License : GNU GPL, version 2 or above
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Instances to marshal (push) and unmarshal (peek) media data.
--}
-module Text.Pandoc.Lua.Marshaling.MediaBag (pushIterator) where
-
-import Foreign.Ptr (Ptr)
-import Foreign.StablePtr (StablePtr, deRefStablePtr, newStablePtr)
-import Foreign.Lua (Lua, NumResults, Peekable, Pushable, StackIndex)
-import Foreign.Lua.Types.Peekable (reportValueOnFailure)
-import Foreign.Lua.Userdata (ensureUserdataMetatable, pushAnyWithMetatable,
- toAnyWithName)
-import Text.Pandoc.MediaBag (MediaBag, mediaItems)
-import Text.Pandoc.MIME (MimeType)
-import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))
-
-import qualified Data.ByteString.Lazy as BL
-import qualified Foreign.Lua as Lua
-import qualified Foreign.Storable as Storable
-
--- | A list of 'MediaBag' items.
-newtype MediaItems = MediaItems [(String, MimeType, BL.ByteString)]
-
-instance Pushable MediaItems where
- push = pushMediaItems
-
-instance Peekable MediaItems where
- peek = peekMediaItems
-
--- | Push an iterator triple to be used with Lua's @for@ loop construct.
--- Each iterator invocation returns a triple containing the item's
--- filename, MIME type, and content.
-pushIterator :: MediaBag -> Lua NumResults
-pushIterator mb = do
- Lua.pushHaskellFunction nextItem
- Lua.push (MediaItems $ mediaItems mb)
- Lua.pushnil
- return 3
-
--- | Lua type name for @'MediaItems'@.
-mediaItemsTypeName :: String
-mediaItemsTypeName = "pandoc MediaItems"
-
--- | Push a @MediaItems@ element to the stack.
-pushMediaItems :: MediaItems -> Lua ()
-pushMediaItems xs = pushAnyWithMetatable pushMT xs
- where
- pushMT = ensureUserdataMetatable mediaItemsTypeName (return ())
-
--- | Retrieve a @MediaItems@ element from the stack.
-peekMediaItems :: StackIndex -> Lua MediaItems
-peekMediaItems = reportValueOnFailure mediaItemsTypeName
- (`toAnyWithName` mediaItemsTypeName)
-
--- | Retrieve a list of items from an iterator state, return the first
--- item (if present), and advance the state.
-nextItem :: Ptr (StablePtr MediaItems) -> AnyValue -> Lua NumResults
-nextItem ptr _ = do
- (MediaItems items) <- Lua.liftIO $ deRefStablePtr =<< Storable.peek ptr
- case items of
- [] -> 2 <$ (Lua.pushnil *> Lua.pushnil)
- (key, mt, content):xs -> do
- Lua.liftIO $ Storable.poke ptr =<< newStablePtr (MediaItems xs)
- Lua.push key
- Lua.push mt
- Lua.push content
- return 3
diff --git a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs b/src/Text/Pandoc/Lua/Marshaling/PandocError.hs
deleted file mode 100644
index f698704e0..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{- |
- Module : Text.Pandoc.Lua.Marshaling.PandocError
- Copyright : © 2020-2021 Albert Krewinkel
- License : GNU GPL, version 2 or above
-
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Marshaling of @'PandocError'@ values.
--}
-module Text.Pandoc.Lua.Marshaling.PandocError
- ( peekPandocError
- , pushPandocError
- )
- where
-
-import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
-import Text.Pandoc.Error (PandocError (PandocLuaError))
-
-import qualified Foreign.Lua as Lua
-import qualified Foreign.Lua.Userdata as Lua
-import qualified Text.Pandoc.Lua.Util as LuaUtil
-import qualified Text.Pandoc.UTF8 as UTF8
-
--- | Userdata name used by Lua for the @PandocError@ type.
-pandocErrorName :: String
-pandocErrorName = "pandoc error"
-
--- | Peek a @'PandocError'@ element to the Lua stack.
-pushPandocError :: PandocError -> Lua ()
-pushPandocError = Lua.pushAnyWithMetatable pushPandocErrorMT
- where
- pushPandocErrorMT = Lua.ensureUserdataMetatable pandocErrorName $
- LuaUtil.addFunction "__tostring" __tostring
-
--- | Retrieve a @'PandocError'@ from the Lua stack.
-peekPandocError :: StackIndex -> Lua PandocError
-peekPandocError idx = Lua.ltype idx >>= \case
- Lua.TypeUserdata -> do
- errMb <- Lua.toAnyWithName idx pandocErrorName
- return $ case errMb of
- Just err -> err
- Nothing -> PandocLuaError "could not retrieve original error"
- _ -> do
- Lua.pushvalue idx
- msg <- Lua.state >>= \l -> Lua.liftIO (Lua.errorMessage l)
- return $ PandocLuaError (UTF8.toText msg)
-
--- | Convert to string.
-__tostring :: PandocError -> Lua String
-__tostring = return . show
-
---
--- Instances
---
-
-instance Pushable PandocError where
- push = pushPandocError
-
-instance Peekable PandocError where
- peek = peekPandocError
diff --git a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs
deleted file mode 100644
index dd7bf2e61..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs
+++ /dev/null
@@ -1,79 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{- |
- Module : Text.Pandoc.Lua.Marshaling.ReaderOptions
- Copyright : © 2012-2021 John MacFarlane
- © 2017-2021 Albert Krewinkel
- License : GNU GPL, version 2 or above
-
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Marshaling instance for ReaderOptions and its components.
--}
-module Text.Pandoc.Lua.Marshaling.ReaderOptions () where
-
-import Data.Data (showConstr, toConstr)
-import Foreign.Lua (Lua, Pushable)
-import Text.Pandoc.Extensions (Extensions)
-import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))
-import Text.Pandoc.Lua.Marshaling.CommonState ()
-import Text.Pandoc.Options (ReaderOptions (..), TrackChanges)
-
-import qualified Data.Set as Set
-import qualified Data.Text as Text
-import qualified Foreign.Lua as Lua
-import qualified Text.Pandoc.Lua.Util as LuaUtil
-
---
--- Reader Options
---
-instance Pushable Extensions where
- push exts = Lua.push (show exts)
-
-instance Pushable TrackChanges where
- push = Lua.push . showConstr . toConstr
-
-instance Pushable ReaderOptions where
- push ro = do
- let ReaderOptions
- (extensions :: Extensions)
- (standalone :: Bool)
- (columns :: Int)
- (tabStop :: Int)
- (indentedCodeClasses :: [Text.Text])
- (abbreviations :: Set.Set Text.Text)
- (defaultImageExtension :: Text.Text)
- (trackChanges :: TrackChanges)
- (stripComments :: Bool)
- = ro
- Lua.newtable
- LuaUtil.addField "extensions" extensions
- LuaUtil.addField "standalone" standalone
- LuaUtil.addField "columns" columns
- LuaUtil.addField "tab_stop" tabStop
- LuaUtil.addField "indented_code_classes" indentedCodeClasses
- LuaUtil.addField "abbreviations" abbreviations
- LuaUtil.addField "default_image_extension" defaultImageExtension
- LuaUtil.addField "track_changes" trackChanges
- LuaUtil.addField "strip_comments" stripComments
-
- -- add metatable
- let indexReaderOptions :: AnyValue -> AnyValue -> Lua Lua.NumResults
- indexReaderOptions _tbl (AnyValue key) = do
- Lua.ltype key >>= \case
- Lua.TypeString -> Lua.peek key >>= \case
- ("defaultImageExtension" :: Text.Text)
- -> Lua.push defaultImageExtension
- "indentedCodeClasses" -> Lua.push indentedCodeClasses
- "stripComments" -> Lua.push stripComments
- "tabStop" -> Lua.push tabStop
- "trackChanges" -> Lua.push trackChanges
- _ -> Lua.pushnil
- _ -> Lua.pushnil
- return 1
- Lua.newtable
- LuaUtil.addFunction "__index" indexReaderOptions
- Lua.setmetatable (Lua.nthFromTop 2)
diff --git a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs
deleted file mode 100644
index 6d43039fa..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{- |
- Module : Text.Pandoc.Lua.Marshaling.SimpleTable
- Copyright : © 2020-2021 Albert Krewinkel
- License : GNU GPL, version 2 or above
-
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Definition and marshaling of the 'SimpleTable' data type used as a
-convenience type when dealing with tables.
--}
-module Text.Pandoc.Lua.Marshaling.SimpleTable
- ( SimpleTable (..)
- , peekSimpleTable
- , pushSimpleTable
- )
- where
-
-import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
-import Text.Pandoc.Definition
-import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor, rawField)
-import Text.Pandoc.Lua.Marshaling.AST ()
-
-import qualified Foreign.Lua as Lua
-
--- | A simple (legacy-style) table.
-data SimpleTable = SimpleTable
- { simpleTableCaption :: [Inline]
- , simpleTableAlignments :: [Alignment]
- , simpleTableColumnWidths :: [Double]
- , simpleTableHeader :: [[Block]]
- , simpleTableBody :: [[[Block]]]
- }
-
-instance Pushable SimpleTable where
- push = pushSimpleTable
-
-instance Peekable SimpleTable where
- peek = peekSimpleTable
-
--- | Push a simple table to the stack by calling the
--- @pandoc.SimpleTable@ constructor.
-pushSimpleTable :: SimpleTable -> Lua ()
-pushSimpleTable tbl = pushViaConstructor "SimpleTable"
- (simpleTableCaption tbl)
- (simpleTableAlignments tbl)
- (simpleTableColumnWidths tbl)
- (simpleTableHeader tbl)
- (simpleTableBody tbl)
-
--- | Retrieve a simple table from the stack.
-peekSimpleTable :: StackIndex -> Lua SimpleTable
-peekSimpleTable idx = defineHowTo "get SimpleTable" $
- SimpleTable
- <$> rawField idx "caption"
- <*> rawField idx "aligns"
- <*> rawField idx "widths"
- <*> rawField idx "headers"
- <*> rawField idx "rows"
diff --git a/src/Text/Pandoc/Lua/Marshaling/Version.hs b/src/Text/Pandoc/Lua/Marshaling/Version.hs
deleted file mode 100644
index 4f4ffac51..000000000
--- a/src/Text/Pandoc/Lua/Marshaling/Version.hs
+++ /dev/null
@@ -1,154 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{- |
- Module : Text.Pandoc.Lua.Marshaling.Version
- Copyright : © 2019-2021 Albert Krewinkel
- License : GNU GPL, version 2 or above
-
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Marshaling of @'Version'@s. The marshaled elements can be compared using
-default comparison operators (like @>@ and @<=@).
--}
-module Text.Pandoc.Lua.Marshaling.Version
- ( peekVersion
- , pushVersion
- )
- where
-
-import Data.Text (Text)
-import Data.Maybe (fromMaybe)
-import Data.Version (Version (..), makeVersion, parseVersion, showVersion)
-import Foreign.Lua (Lua, Optional (..), NumResults,
- Peekable, Pushable, StackIndex)
-import Foreign.Lua.Types.Peekable (reportValueOnFailure)
-import Foreign.Lua.Userdata (ensureUserdataMetatable, pushAnyWithMetatable,
- toAnyWithName)
-import Safe (atMay, lastMay)
-import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))
-import Text.ParserCombinators.ReadP (readP_to_S)
-
-import qualified Foreign.Lua as Lua
-import qualified Text.Pandoc.Lua.Util as LuaUtil
-
--- | Push a @'Version'@ element to the Lua stack.
-pushVersion :: Version -> Lua ()
-pushVersion version = pushAnyWithMetatable pushVersionMT version
- where
- pushVersionMT = ensureUserdataMetatable versionTypeName $ do
- LuaUtil.addFunction "__eq" __eq
- LuaUtil.addFunction "__le" __le
- LuaUtil.addFunction "__lt" __lt
- LuaUtil.addFunction "__len" __len
- LuaUtil.addFunction "__index" __index
- LuaUtil.addFunction "__pairs" __pairs
- LuaUtil.addFunction "__tostring" __tostring
-
-instance Pushable Version where
- push = pushVersion
-
-peekVersion :: StackIndex -> Lua Version
-peekVersion idx = Lua.ltype idx >>= \case
- Lua.TypeString -> do
- versionStr <- Lua.peek idx
- let parses = readP_to_S parseVersion versionStr
- case lastMay parses of
- Just (v, "") -> return v
- _ -> Lua.throwMessage $ "could not parse as Version: " ++ versionStr
-
- Lua.TypeUserdata ->
- reportValueOnFailure versionTypeName
- (`toAnyWithName` versionTypeName)
- idx
- Lua.TypeNumber -> do
- n <- Lua.peek idx
- return (makeVersion [n])
-
- Lua.TypeTable ->
- makeVersion <$> Lua.peek idx
-
- _ ->
- Lua.throwMessage "could not peek Version"
-
-instance Peekable Version where
- peek = peekVersion
-
--- | Name used by Lua for the @CommonState@ type.
-versionTypeName :: String
-versionTypeName = "HsLua Version"
-
-__eq :: Version -> Version -> Lua Bool
-__eq v1 v2 = return (v1 == v2)
-
-__le :: Version -> Version -> Lua Bool
-__le v1 v2 = return (v1 <= v2)
-
-__lt :: Version -> Version -> Lua Bool
-__lt v1 v2 = return (v1 < v2)
-
--- | Get number of version components.
-__len :: Version -> Lua Int
-__len = return . length . versionBranch
-
--- | Access fields.
-__index :: Version -> AnyValue -> Lua NumResults
-__index v (AnyValue k) = do
- ty <- Lua.ltype k
- case ty of
- Lua.TypeNumber -> do
- n <- Lua.peek k
- let versionPart = atMay (versionBranch v) (n - 1)
- Lua.push (Lua.Optional versionPart)
- return 1
- Lua.TypeString -> do
- (str :: Text) <- Lua.peek k
- if str == "must_be_at_least"
- then 1 <$ Lua.pushHaskellFunction must_be_at_least
- else 1 <$ Lua.pushnil
- _ -> 1 <$ Lua.pushnil
-
--- | Create iterator.
-__pairs :: Version -> Lua NumResults
-__pairs v = do
- Lua.pushHaskellFunction nextFn
- Lua.pushnil
- Lua.pushnil
- return 3
- where
- nextFn :: AnyValue -> Optional Int -> Lua Lua.NumResults
- nextFn _ (Optional key) =
- case key of
- Nothing -> case versionBranch v of
- [] -> 2 <$ (Lua.pushnil *> Lua.pushnil)
- n:_ -> 2 <$ (Lua.push (1 :: Int) *> Lua.push n)
- Just n -> case atMay (versionBranch v) n of
- Nothing -> 2 <$ (Lua.pushnil *> Lua.pushnil)
- Just b -> 2 <$ (Lua.push (n + 1) *> Lua.push b)
-
--- | Convert to string.
-__tostring :: Version -> Lua String
-__tostring v = return (showVersion v)
-
--- | Default error message when a version is too old. This message is
--- formatted in Lua with the expected and actual versions as arguments.
-versionTooOldMessage :: String
-versionTooOldMessage = "expected version %s or newer, got %s"
-
--- | Throw an error if this version is older than the given version.
--- FIXME: This function currently requires the string library to be
--- loaded.
-must_be_at_least :: Version -> Version -> Optional String -> Lua NumResults
-must_be_at_least actual expected optMsg = do
- let msg = fromMaybe versionTooOldMessage (fromOptional optMsg)
- if expected <= actual
- then return 0
- else do
- Lua.getglobal' "string.format"
- Lua.push msg
- Lua.push (showVersion expected)
- Lua.push (showVersion actual)
- Lua.call 3 1
- Lua.error
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-15 14:32:53 +0000