From 437bd8e7f956ec645aa5261cbb9085741c8398cd Mon Sep 17 00:00:00 2001
From: "John J. Camilleri" <john@digitalgrammars.com>
Date: Mon, 3 May 2021 20:36:31 +0200
Subject: Add proper error handling in complete

---
 src/runtime/haskell-bind/PGF2.hsc | 22 +++++++++++++++++++---
 1 file changed, 19 insertions(+), 3 deletions(-)

(limited to 'src/runtime/haskell-bind/PGF2.hsc')

diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index 21e8693eb..b3b349ee1 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -988,11 +988,27 @@ complete lang (Type ctype _) sent pfx mn =
     failed <- gu_exn_is_raised exn
     if failed
     then do
-      -- TODO better error handling, cleanup
       is_parse_error <- gu_exn_caught exn gu_exn_type_PgfParseError
       if is_parse_error
-      then return (ParseFailed 0 "")
-      else throwIO (PGFError "Some other error")
+      then do
+        c_err <- (#peek GuExn, data.data) exn
+        c_offset <- (#peek PgfParseError, offset) c_err
+        token_ptr <- (#peek PgfParseError, token_ptr) c_err
+        token_len <- (#peek PgfParseError, token_len) c_err
+        tok <- peekUtf8CStringLen token_ptr token_len
+        gu_pool_free parsePl
+        return (ParseFailed (fromIntegral (c_offset :: CInt)) tok)
+      else do
+        is_exn <- gu_exn_caught exn gu_exn_type_PgfExn
+        if is_exn
+        then do
+          c_msg <- (#peek GuExn, data.data) exn
+          msg <- peekUtf8CString c_msg
+          gu_pool_free parsePl
+          throwIO (PGFError msg)
+        else do
+          gu_pool_free parsePl
+          throwIO (PGFError "Parsing failed")
     else do
       fpl <- newForeignPtr gu_pool_finalizer parsePl
       ParseOk <$> fromCompletions enum fpl
-- 
cgit v1.2.3