aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Lua/Marshaling/PandocError.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Lua/Marshaling/PandocError.hs')
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/PandocError.hs65
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