diff options
Diffstat (limited to 'src/Text/Pandoc/Lua/Marshaling')
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/AST.hs | 15 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/PandocError.hs | 65 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/Version.hs | 4 |
3 files changed, 77 insertions, 7 deletions
diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 81b206f67..8d7e83dc1 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -19,9 +19,11 @@ module Text.Pandoc.Lua.Marshaling.AST import Control.Applicative ((<|>)) 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 @@ -131,7 +133,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do Lua.TypeBoolean -> MetaBool <$> Lua.peek idx Lua.TypeString -> MetaString <$> Lua.peek idx Lua.TypeTable -> do - tag <- Lua.try $ LuaUtil.getTag idx + tag <- try $ LuaUtil.getTag idx case tag of Right "MetaBlocks" -> MetaBlocks <$> elementContent Right "MetaBool" -> MetaBool <$> elementContent @@ -139,7 +141,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do Right "MetaInlines" -> MetaInlines <$> elementContent Right "MetaList" -> MetaList <$> elementContent Right "MetaString" -> MetaString <$> elementContent - Right t -> Lua.throwException ("Unknown meta tag: " <> t) + Right t -> Lua.throwMessage ("Unknown meta tag: " <> t) Left _ -> do -- no meta value tag given, try to guess. len <- Lua.rawlen idx @@ -148,7 +150,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do else (MetaInlines <$> Lua.peek idx) <|> (MetaBlocks <$> Lua.peek idx) <|> (MetaList <$> Lua.peek idx) - _ -> Lua.throwException "could not get meta value" + _ -> Lua.throwMessage "could not get meta value" -- | Push a block element to the top of the Lua stack. pushBlock :: Block -> Lua () @@ -199,7 +201,7 @@ peekBlock idx = defineHowTo "get Block value" $ do tbodies tfoot) <$> elementContent - _ -> Lua.throwException ("Unknown block type: " <> tag) + _ -> Lua.throwMessage ("Unknown block type: " <> tag) where -- Get the contents of an AST element. elementContent :: Peekable a => Lua a @@ -344,12 +346,15 @@ peekInline idx = defineHowTo "get Inline value" $ do "Strong" -> Strong <$> elementContent "Subscript" -> Subscript <$> elementContent "Superscript"-> Superscript <$> elementContent - _ -> Lua.throwException ("Unknown inline type: " <> tag) + _ -> 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 diff --git a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs b/src/Text/Pandoc/Lua/Marshaling/PandocError.hs new file mode 100644 index 000000000..74537a1dd --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshaling/PandocError.hs @@ -0,0 +1,65 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{- | + Module : Text.Pandoc.Lua.Marshaling.PandocError + Copyright : © 2020 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/Version.hs b/src/Text/Pandoc/Lua/Marshaling/Version.hs index 090725afc..9adb1b763 100644 --- a/src/Text/Pandoc/Lua/Marshaling/Version.hs +++ b/src/Text/Pandoc/Lua/Marshaling/Version.hs @@ -57,7 +57,7 @@ peekVersion idx = Lua.ltype idx >>= \case let parses = readP_to_S parseVersion versionStr case lastMay parses of Just (v, "") -> return v - _ -> Lua.throwException $ "could not parse as Version: " ++ versionStr + _ -> Lua.throwMessage $ "could not parse as Version: " ++ versionStr Lua.TypeUserdata -> reportValueOnFailure versionTypeName @@ -71,7 +71,7 @@ peekVersion idx = Lua.ltype idx >>= \case makeVersion <$> Lua.peek idx _ -> - Lua.throwException "could not peek Version" + Lua.throwMessage "could not peek Version" instance Peekable Version where peek = peekVersion |