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

Add proper error handling in complete

Browse Source
This commit is contained in:
John J. Camilleri
2021-05-03 20:36:31 +02:00
parent e56d1b2959
commit 437bd8e7f9
2 changed files with 31 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
src/runtime/haskell-bind/PGF2.hsc
View File

@@ -988,11 +988,27 @@ complete lang (Type ctype _) sent pfx mn =
failed <- gu_exn_is_raised exn failed <- gu_exn_is_raised exn
if failed if failed
then do then do
-- TODO better error handling, cleanup
is_parse_error <- gu_exn_caught exn gu_exn_type_PgfParseError is_parse_error <- gu_exn_caught exn gu_exn_type_PgfParseError
if is_parse_error if is_parse_error
then return (ParseFailed 0 "") then do
else throwIO (PGFError "Some other error") 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 else do
fpl <- newForeignPtr gu_pool_finalizer parsePl fpl <- newForeignPtr gu_pool_finalizer parsePl
ParseOk <$> fromCompletions enum fpl ParseOk <$> fromCompletions enum fpl

18
src/runtime/haskell-bind/test.hs
View File

@@ -4,9 +4,15 @@ import qualified Data.Map as M
main :: IO () main :: IO ()
main = do main = do
pgf <- readPGF "/Users/john/repositories/GF/contrib/foods/Foods.pgf" pgf <- readPGF "/Users/john/repositories/GF/contrib/foods/Foods.pgf"
let Just concr = M.lookup "FoodsEng" (languages pgf) let
let pr = complete concr (startCat pgf) "" "th" Nothing Just concr = M.lookup "FoodsEng" (languages pgf)
case pr of loop = do
ParseOk x -> print x putStr "> "
ParseFailed _ _ -> putStrLn "parse failed" tks <- words <$> getLine
ParseIncomplete -> putStrLn "input incomplete" let pr = complete concr (startCat pgf) (unwords (init tks)) (last tks) Nothing
case pr of
ParseOk x -> print x
ParseFailed x s -> putStrLn $ "parse failed at " ++ show x ++ " " ++ s
ParseIncomplete -> putStrLn "input incomplete"
loop
loop