GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-06 01:32:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

In case of exception, report the offending function

Browse Source
This commit is contained in:
krangelov
2021-09-17 11:22:18 +02:00
parent 3f31d86d0d
commit ddb01b41be
3 changed files with 29 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
src/runtime/haskell/PGF2/FFI.hsc
View File

@@ -219,12 +219,15 @@ utf8Length s = count 0 s
-----------------------------------------------------------------------
-- Exceptions
newtype PGFError = PGFError String
deriving (Show, Typeable)
data PGFError = PGFError String String
deriving Typeable
instance Show PGFError where
show (PGFError loc msg) = loc++": "++msg
instance Exception PGFError
withPgfExn f =
withPgfExn loc f =
allocaBytes (#size PgfExn) $ \c_exn -> do
res <- f c_exn
ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType)
@@ -236,13 +239,13 @@ withPgfExn f =
mb_fpath <- if c_msg == nullPtr
then return Nothing
else fmap Just (peekCString c_msg)
ioError (errnoToIOError "readPGF" (Errno errno) Nothing mb_fpath)
ioError (errnoToIOError loc (Errno errno) Nothing mb_fpath)
(#const PGF_EXN_PGF_ERROR) -> do
c_msg <- (#peek PgfExn, msg) c_exn
msg <- peekCString c_msg
free c_msg
throwIO (PGFError msg)
_ -> throwIO (PGFError "An unidentified error occurred")
throwIO (PGFError loc msg)
_ -> throwIO (PGFError loc "An unidentified error occurred")
-----------------------------------------------------------------------
-- Marshalling