diff options
Diffstat (limited to 'src/Text/Pandoc/Lua/Marshaling/PandocError.hs')
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/PandocError.hs | 65 |
1 files changed, 65 insertions, 0 deletions
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 |