diff options
Diffstat (limited to 'src/Text/Pandoc')
| -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 | 
