Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

T.P.Lua: split StackInstances into smaller Marshaling modules

Browse source
This commit is contained in:
Albert Krewinkel 2019-02-16 12:08:22 +01:00
parent 85470c49fe
commit 331d6224a1
No known key found for this signature in database
GPG key ID: 388DC0B21F631124
12 changed files with 240 additions and 175 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
pandoc.cabal
View file

@ -575,11 +575,15 @@ library
Text.Pandoc.Lua.Filter,
Text.Pandoc.Lua.Global,
Text.Pandoc.Lua.Init,
Text.Pandoc.Lua.Marshaling,
Text.Pandoc.Lua.Marshaling.AST,
Text.Pandoc.Lua.Marshaling.AnyValue,
Text.Pandoc.Lua.Marshaling.CommonState,
Text.Pandoc.Lua.Marshaling.ReaderOptions,
Text.Pandoc.Lua.Module.MediaBag,
Text.Pandoc.Lua.Module.Pandoc,
Text.Pandoc.Lua.Module.Utils,
Text.Pandoc.Lua.Packages,
Text.Pandoc.Lua.StackInstances,
Text.Pandoc.Lua.Util,
Text.Pandoc.CSS,
Text.Pandoc.CSV,

2
src/Text/Pandoc/Lua.hs
View file

@ -39,5 +39,5 @@ module Text.Pandoc.Lua
import Text.Pandoc.Lua.Filter (runFilterFile)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Init (LuaException (..), runLua)
import Text.Pandoc.Lua.StackInstances ()
import Text.Pandoc.Lua.Marshaling ()

2
src/Text/Pandoc/Lua/Filter.hs
View file

@ -48,7 +48,7 @@ import Data.Foldable (foldrM)
import Data.Map (Map)
import Foreign.Lua (Lua, Peekable, Pushable)
import Text.Pandoc.Definition
import Text.Pandoc.Lua.StackInstances ()
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Walk (walkM, Walkable)
import qualified Data.Map.Strict as Map

2
src/Text/Pandoc/Lua/Global.hs
View file

@ -41,7 +41,7 @@ import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable
import Paths_pandoc (version)
import Text.Pandoc.Class (CommonState)
import Text.Pandoc.Definition (Pandoc (Pandoc), pandocTypesVersion)
import Text.Pandoc.Lua.StackInstances ()
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Util (addFunction)
import Text.Pandoc.Options (ReaderOptions)

16
src/Text/Pandoc/Lua/Marshaling.hs Normal file
View file

@ -0,0 +1,16 @@
{- |
Module : Text.Pandoc.Lua.Marshaling
Copyright : © 2012-2019 John MacFarlane
© 2017-2019 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
Lua marshaling (pushing) and unmarshaling (peeking) instances.
-}
module Text.Pandoc.Lua.Marshaling () where
import Text.Pandoc.Lua.Marshaling.AST ()
import Text.Pandoc.Lua.Marshaling.CommonState ()
import Text.Pandoc.Lua.Marshaling.ReaderOptions ()

174
src/Text/Pandoc/Lua/StackInstances.hs → src/Text/Pandoc/Lua/Marshaling/AST.hs
View file

@ -1,28 +1,10 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-
Copyright © 2012-2019 John MacFarlane <jgm@berkeley.edu>
2017-2019 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- |
Module : Text.Pandoc.Lua.StackInstances
Module : Text.Pandoc.Lua.Marshaling.AST
Copyright : © 2012-2019 John MacFarlane
© 2017-2019 Albert Krewinkel
License : GNU GPL, version 2 or above
@ -30,27 +12,20 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
StackValue instances for pandoc types.
Marshaling/unmarshaling instances for document AST elements.
-}
module Text.Pandoc.Lua.StackInstances () where
module Text.Pandoc.Lua.Marshaling.AST () where
import Prelude
import Control.Applicative ((<|>))
import Data.Data (showConstr, toConstr)
import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
import Foreign.Lua.Types.Peekable (reportValueOnFailure)
import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable
, toAnyWithName, metatableName)
import Text.Pandoc.Class (CommonState (..))
, metatableName)
import Text.Pandoc.Definition
import Text.Pandoc.Extensions (Extensions)
import Text.Pandoc.Logging (LogMessage, showLogMessage)
import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
import Text.Pandoc.Options (ReaderOptions (..), TrackChanges)
import Text.Pandoc.Lua.Marshaling.CommonState ()
import Text.Pandoc.Shared (Element (Blk, Sec))
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
@ -335,140 +310,3 @@ indexElement = \case
"tag" -> Lua.push "Sec"
"t" -> Lua.push "Sec"
_ -> Lua.pushnil
--
-- 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 :: [String])
(abbreviations :: Set.Set String)
(defaultImageExtension :: String)
(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" -> 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)
-- | Dummy type to allow values of arbitrary Lua type.
newtype AnyValue = AnyValue StackIndex
--
-- TODO: Much of the following should be abstracted, factored out
-- and go into HsLua.
--
instance Peekable AnyValue where
peek = return . AnyValue
-- | 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 :: String -> 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 :: [(String, 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 String
tostringLogMessage = return . showLogMessage

26
src/Text/Pandoc/Lua/Marshaling/AnyValue.hs Normal file
View file

@ -0,0 +1,26 @@
{-# LANGUAGE NoImplicitPrelude #-}
{- |
Module : Text.Pandoc.Lua.Marshaling.AnyValue
Copyright : © 2017-2019 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 Prelude
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

102
src/Text/Pandoc/Lua/Marshaling/CommonState.hs Normal file
View file

@ -0,0 +1,102 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{- |
Module : Text.Pandoc.Lua.Marshaling.CommonState
Copyright : © 2012-2019 John MacFarlane
© 2017-2019 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 Prelude
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 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 :: String -> 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 :: [(String, 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 String
tostringLogMessage = return . showLogMessage

79
src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs Normal file
View file

@ -0,0 +1,79 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module : Text.Pandoc.Lua.Marshaling.ReaderOptions
Copyright : © 2012-2019 John MacFarlane
© 2017-2019 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 Prelude
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 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 :: [String])
(abbreviations :: Set.Set String)
(defaultImageExtension :: String)
(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" -> 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)

2
src/Text/Pandoc/Lua/Module/MediaBag.hs
View file

@ -36,7 +36,7 @@ import Data.Maybe (fromMaybe)
import Foreign.Lua (Lua, NumResults, Optional, liftIO)
import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState,
runIOorExplode, setMediaBag)
import Text.Pandoc.Lua.StackInstances ()
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Util (addFunction)
import Text.Pandoc.MIME (MimeType)

2
src/Text/Pandoc/Lua/Module/Pandoc.hs
View file

@ -41,7 +41,7 @@ import System.Exit (ExitCode (..))
import Text.Pandoc.Class (runIO)
import Text.Pandoc.Definition (Block, Inline)
import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter)
import Text.Pandoc.Lua.StackInstances ()
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Walk (Walkable)
import Text.Pandoc.Options (ReaderOptions (readerExtensions))
import Text.Pandoc.Process (pipeProcess)

2
src/Text/Pandoc/Lua/Module/Utils.hs
View file

@ -38,7 +38,7 @@ import Foreign.Lua (Peekable, Lua, NumResults)
import Text.Pandoc.Class (runIO, setUserDataDir)
import Text.Pandoc.Definition ( Pandoc, Meta, MetaValue (..), Block, Inline
, Citation, Attr, ListAttributes)
import Text.Pandoc.Lua.StackInstances ()
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Util (addFunction)
import qualified Data.Digest.Pure.SHA as SHA