{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {- | Module : Text.Pandoc.Lua.Marshaling.PandocError Copyright : © 2020-2021 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