diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Pandoc/Lua/Global.hs | 5 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling.hs | 1 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/Version.hs | 154 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Module/Types.hs | 28 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Module/Utils.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Packages.hs | 2 |
6 files changed, 189 insertions, 3 deletions
diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs index f303af6c5..b9b6c9cd9 100644 --- a/src/Text/Pandoc/Lua/Global.hs +++ b/src/Text/Pandoc/Lua/Global.hs @@ -17,7 +17,6 @@ module Text.Pandoc.Lua.Global import Prelude import Data.Data (Data) -import Data.Version (Version (versionBranch)) import Foreign.Lua (Lua, Peekable, Pushable) import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable , metatableName) @@ -52,7 +51,7 @@ setGlobal global = case global of Lua.push format Lua.setglobal "FORMAT" PANDOC_API_VERSION -> do - Lua.push (versionBranch pandocTypesVersion) + Lua.push pandocTypesVersion Lua.setglobal "PANDOC_API_VERSION" PANDOC_DOCUMENT doc -> do Lua.push (LazyPandoc doc) @@ -67,7 +66,7 @@ setGlobal global = case global of Lua.push commonState Lua.setglobal "PANDOC_STATE" PANDOC_VERSION -> do - Lua.push (versionBranch version) + Lua.push version Lua.setglobal "PANDOC_VERSION" -- | Readonly and lazy pandoc objects. diff --git a/src/Text/Pandoc/Lua/Marshaling.hs b/src/Text/Pandoc/Lua/Marshaling.hs index cc0451c09..8a1270ab7 100644 --- a/src/Text/Pandoc/Lua/Marshaling.hs +++ b/src/Text/Pandoc/Lua/Marshaling.hs @@ -14,3 +14,4 @@ module Text.Pandoc.Lua.Marshaling () where import Text.Pandoc.Lua.Marshaling.AST () import Text.Pandoc.Lua.Marshaling.CommonState () import Text.Pandoc.Lua.Marshaling.ReaderOptions () +import Text.Pandoc.Lua.Marshaling.Version () diff --git a/src/Text/Pandoc/Lua/Marshaling/Version.hs b/src/Text/Pandoc/Lua/Marshaling/Version.hs new file mode 100644 index 000000000..3c667cbc4 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshaling/Version.hs @@ -0,0 +1,154 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} +{- | + Module : Text.Pandoc.Lua.Marshaling.Version + Copyright : © 2019 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 Prelude +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.throwException $ "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.throwException "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 <- 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 = "version too old: 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 + diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs new file mode 100644 index 000000000..641bde7d6 --- /dev/null +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -0,0 +1,28 @@ +{- | + Module : Text.Pandoc.Lua.Module.Types + Copyright : © 2019 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + Stability : alpha + +Pandoc data type constructors. +-} +module Text.Pandoc.Lua.Module.Types + ( pushModule + ) where + +import Prelude +import Data.Version (Version) +import Foreign.Lua (Lua, NumResults) +import Text.Pandoc.Lua.Marshaling.Version () +import Text.Pandoc.Lua.Util (addFunction) + +import qualified Foreign.Lua as Lua + +-- | Push the pandoc.system module on the Lua stack. +pushModule :: Lua NumResults +pushModule = do + Lua.newtable + addFunction "Version" (return :: Version -> Lua Version) + return 1 diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 7f201a4b2..21e3f5674 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -17,6 +17,7 @@ import Prelude import Control.Applicative ((<|>)) import Data.Char (toLower) import Data.Default (def) +import Data.Version (Version) import Foreign.Lua (Peekable, Lua, NumResults) import Text.Pandoc.Class (runIO, setUserDataDir) import Text.Pandoc.Definition ( Pandoc, Meta, MetaValue (..), Block, Inline @@ -43,6 +44,7 @@ pushModule mbDatadir = do addFunction "sha1" sha1 addFunction "stringify" stringify addFunction "to_roman_numeral" toRomanNumeral + addFunction "Version" (return :: Version -> Lua Version) return 1 -- | Squashes a list of blocks into inlines. diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs index 5f2751f52..ca1779e27 100644 --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -26,6 +26,7 @@ import qualified Foreign.Lua as Lua import Text.Pandoc.Lua.Module.Pandoc as Pandoc import Text.Pandoc.Lua.Module.MediaBag as MediaBag import Text.Pandoc.Lua.Module.System as System +import Text.Pandoc.Lua.Module.Types as Types import Text.Pandoc.Lua.Module.Utils as Utils -- | Parameters used to create lua packages/modules. @@ -54,6 +55,7 @@ pandocPackageSearcher pkgParams pkgName = in pushWrappedHsFun (Pandoc.pushModule datadir) "pandoc.mediabag" -> pushWrappedHsFun MediaBag.pushModule "pandoc.system" -> pushWrappedHsFun System.pushModule + "pandoc.types" -> pushWrappedHsFun Types.pushModule "pandoc.utils" -> let datadir = luaPkgDataDir pkgParams in pushWrappedHsFun (Utils.pushModule datadir) _ -> searchPureLuaLoader |