@@ -1,28 +1,10 @@
1+{-# OPTIONS_GHC -fno-warn-orphans #-}
12{-# LANGUAGE NoImplicitPrelude #-}
23{-# LANGUAGE FlexibleInstances #-}
34{-# LANGUAGE ScopedTypeVariables #-}
45{-# LANGUAGE LambdaCase #-}
5−{-# OPTIONS_GHC -fno-warn-orphans #-}
6−{-
7−Copyright © 2012-2019 John MacFarlane <jgm@berkeley.edu>
8− 2017-2019 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
9−
10−This program is free software; you can redistribute it and/or modify
11−it under the terms of the GNU General Public License as published by
12−the Free Software Foundation; either version 2 of the License, or
13−(at your option) any later version.
14−
15−This program is distributed in the hope that it will be useful,
16−but WITHOUT ANY WARRANTY; without even the implied warranty of
17−MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18−GNU General Public License for more details.
19−
20−You should have received a copy of the GNU General Public License
21−along with this program; if not, write to the Free Software
22−Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23−-}
246{- |
25− Module : Text.Pandoc.Lua.StackInstances
7+ Module : Text.Pandoc.Lua.Marshaling.AST
268 Copyright : © 2012-2019 John MacFarlane
279 © 2017-2019 Albert Krewinkel
2810 License : GNU GPL, version 2 or above
@@ -30,27 +12,20 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
3012 Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
3113 Stability : alpha
3214
33−StackValue instances for pandoc types.
15+Marshaling/unmarshaling instances for document AST elements.
3416-}
35−module Text.Pandoc.Lua.StackInstances () where
17+module Text.Pandoc.Lua.Marshaling.AST () where
3618
3719import Prelude
3820import Control.Applicative ((<|>))
39−import Data.Data (showConstr, toConstr)
4021import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
41−import Foreign.Lua.Types.Peekable (reportValueOnFailure)
4222import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable
43− , toAnyWithName, metatableName)
44−import Text.Pandoc.Class (CommonState (..))
23+ , metatableName)
4524import Text.Pandoc.Definition
46−import Text.Pandoc.Extensions (Extensions)
47−import Text.Pandoc.Logging (LogMessage, showLogMessage)
4825import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
49−import Text.Pandoc.Options (ReaderOptions (..), TrackChanges)
26+import Text.Pandoc.Lua.Marshaling.CommonState ()
5027import Text.Pandoc.Shared (Element (Blk, Sec))
5128
52−import qualified Data.Map as Map
53−import qualified Data.Set as Set
5429import qualified Foreign.Lua as Lua
5530import qualified Text.Pandoc.Lua.Util as LuaUtil
5631
@@ -335,140 +310,3 @@ indexElement = \case
335310 "tag" -> Lua.push "Sec"
336311 "t" -> Lua.push "Sec"
337312 _ -> Lua.pushnil
338−
339−
340−--
341−-- Reader Options
342−--
343−instance Pushable Extensions where
344− push exts = Lua.push (show exts)
345−
346−instance Pushable TrackChanges where
347− push = Lua.push . showConstr . toConstr
348−
349−instance Pushable ReaderOptions where
350− push ro = do
351− let ReaderOptions
352− (extensions :: Extensions)
353− (standalone :: Bool)
354− (columns :: Int)
355− (tabStop :: Int)
356− (indentedCodeClasses :: [String])
357− (abbreviations :: Set.Set String)
358− (defaultImageExtension :: String)
359− (trackChanges :: TrackChanges)
360− (stripComments :: Bool)
361− = ro
362− Lua.newtable
363− LuaUtil.addField "extensions" extensions
364− LuaUtil.addField "standalone" standalone
365− LuaUtil.addField "columns" columns
366− LuaUtil.addField "tab_stop" tabStop
367− LuaUtil.addField "indented_code_classes" indentedCodeClasses
368− LuaUtil.addField "abbreviations" abbreviations
369− LuaUtil.addField "default_image_extension" defaultImageExtension
370− LuaUtil.addField "track_changes" trackChanges
371− LuaUtil.addField "strip_comments" stripComments
372−
373− -- add metatable
374− let indexReaderOptions :: AnyValue -> AnyValue -> Lua Lua.NumResults
375− indexReaderOptions _tbl (AnyValue key) = do
376− Lua.ltype key >>= \case
377− Lua.TypeString -> Lua.peek key >>= \case
378− "defaultImageExtension" -> Lua.push defaultImageExtension
379− "indentedCodeClasses" -> Lua.push indentedCodeClasses
380− "stripComments" -> Lua.push stripComments
381− "tabStop" -> Lua.push tabStop
382− "trackChanges" -> Lua.push trackChanges
383− _ -> Lua.pushnil
384− _ -> Lua.pushnil
385− return 1
386− Lua.newtable
387− LuaUtil.addFunction "__index" indexReaderOptions
388− Lua.setmetatable (Lua.nthFromTop 2)
389−
390−-- | Dummy type to allow values of arbitrary Lua type.
391−newtype AnyValue = AnyValue StackIndex
392−
393−--
394−-- TODO: Much of the following should be abstracted, factored out
395−-- and go into HsLua.
396−--
397−
398−instance Peekable AnyValue where
399− peek = return . AnyValue
400−
401−-- | Name used by Lua for the @CommonState@ type.
402−commonStateTypeName :: String
403−commonStateTypeName = "Pandoc CommonState"
404−
405−instance Peekable CommonState where
406− peek idx = reportValueOnFailure commonStateTypeName
407− (`toAnyWithName` commonStateTypeName) idx
408−
409−instance Pushable CommonState where
410− push st = pushAnyWithMetatable pushCommonStateMetatable st
411− where
412− pushCommonStateMetatable = ensureUserdataMetatable commonStateTypeName $ do
413− LuaUtil.addFunction "__index" indexCommonState
414− LuaUtil.addFunction "__pairs" pairsCommonState
415−
416−indexCommonState :: CommonState -> AnyValue -> Lua Lua.NumResults
417−indexCommonState st (AnyValue idx) = Lua.ltype idx >>= \case
418− Lua.TypeString -> 1 <$ (Lua.peek idx >>= pushField)
419− _ -> 1 <$ Lua.pushnil
420− where
421− pushField :: String -> Lua ()
422− pushField name = case lookup name commonStateFields of
423− Just pushValue -> pushValue st
424− Nothing -> Lua.pushnil
425−
426−pairsCommonState :: CommonState -> Lua Lua.NumResults
427−pairsCommonState st = do
428− Lua.pushHaskellFunction nextFn
429− Lua.pushnil
430− Lua.pushnil
431− return 3
432− where
433− nextFn :: AnyValue -> AnyValue -> Lua Lua.NumResults
434− nextFn _ (AnyValue idx) =
435− Lua.ltype idx >>= \case
436− Lua.TypeNil -> case commonStateFields of
437− [] -> 2 <$ (Lua.pushnil *> Lua.pushnil)
438− (key, pushValue):_ -> 2 <$ (Lua.push key *> pushValue st)
439− Lua.TypeString -> do
440− key <- Lua.peek idx
441− case tail $ dropWhile ((/= key) . fst) commonStateFields of
442− [] -> 2 <$ (Lua.pushnil *> Lua.pushnil)
443− (nextKey, pushValue):_ -> 2 <$ (Lua.push nextKey *> pushValue st)
444− _ -> 2 <$ (Lua.pushnil *> Lua.pushnil)
445−
446−commonStateFields :: [(String, CommonState -> Lua ())]
447−commonStateFields =
448− [ ("input_files", Lua.push . stInputFiles)
449− , ("output_file", Lua.push . Lua.Optional . stOutputFile)
450− , ("log", Lua.push . stLog)
451− , ("request_headers", Lua.push . Map.fromList . stRequestHeaders)
452− , ("resource_path", Lua.push . stResourcePath)
453− , ("source_url", Lua.push . Lua.Optional . stSourceURL)
454− , ("user_data_dir", Lua.push . Lua.Optional . stUserDataDir)
455− , ("trace", Lua.push . stTrace)
456− , ("verbosity", Lua.push . show . stVerbosity)
457− ]
458−
459−-- | Name used by Lua for the @CommonState@ type.
460−logMessageTypeName :: String
461−logMessageTypeName = "Pandoc LogMessage"
462−
463−instance Peekable LogMessage where
464− peek idx = reportValueOnFailure logMessageTypeName
465− (`toAnyWithName` logMessageTypeName) idx
466−
467−instance Pushable LogMessage where
468− push msg = pushAnyWithMetatable pushLogMessageMetatable msg
469− where
470− pushLogMessageMetatable = ensureUserdataMetatable logMessageTypeName $
471− LuaUtil.addFunction "__tostring" tostringLogMessage
472−
473−tostringLogMessage :: LogMessage -> Lua String
474−tostringLogMessage = return . showLogMessage