From e56d1b29593bef6ea3a70b50287df3e3438207d7 Mon Sep 17 00:00:00 2001
From: "John J. Camilleri" <john@digitalgrammars.com>
Date: Mon, 3 May 2021 14:25:35 +0200
Subject: [PATCH] Second attempt. Reading enum is closer to working but all
 strings are empty.

---
 src/runtime/haskell-bind/PGF2.hsc | 32 ++++++++++++++++++++++---------
 src/runtime/haskell-bind/test.hs  |  4 ++--
 2 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index bd7cf2fe9..21e8693eb 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -977,30 +977,44 @@ complete :: Concr      -- ^ the language with which we parse
          -> String     -- ^ the input sentence
          -> String     -- ^ prefix (?)
          -> Maybe Int  -- ^ maximum number of results
-         -> ParseOutput [(Expr,Float)]
+         -> ParseOutput [String]
 complete lang (Type ctype _) sent pfx mn =
   unsafePerformIO $ do
     parsePl <- gu_new_pool
-    exprPl  <- gu_new_pool
     exn     <- gu_new_exn parsePl
-
     sent <- newUtf8CString sent parsePl
     pfx  <- newUtf8CString pfx parsePl
-
     enum <- pgf_complete (concr lang) ctype sent pfx exn parsePl
     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")
-      -- TODO cleanup!!!
     else do
-      parseFPl <- newForeignPtr gu_pool_finalizer parsePl
-      exprFPl  <- newForeignPtr gu_pool_finalizer exprPl
-      exprs    <- fromPgfExprEnum enum parseFPl (touchConcr lang >> touchForeignPtr exprFPl)
-      return (ParseOk exprs)
+      fpl <- newForeignPtr gu_pool_finalizer parsePl
+      ParseOk <$> fromCompletions enum fpl
+  where
+    fromCompletions :: Ptr GuEnum -> ForeignPtr GuPool -> IO [String]
+    fromCompletions enum fpl =
+      withGuPool $ \tmpPl -> do
+        cmpEntry <- alloca $ \ptr ->
+                      withForeignPtr fpl $ \pl ->
+                        do gu_enum_next enum ptr pl
+                           peek ptr
+        if cmpEntry == nullPtr
+        then do
+          finalizeForeignPtr fpl
+          touchConcr lang
+          return []
+        else do
+          (sb,out) <- newOut tmpPl
+          cstr <- gu_string_buf_freeze sb tmpPl
+          tok  <- peekUtf8CString cstr
+          toks <- unsafeInterleaveIO (fromCompletions enum fpl)
+          return (tok : toks)
 
 -- | Returns True if there is a linearization defined for that function in that language
 hasLinearization :: Concr -> Fun -> Bool
diff --git a/src/runtime/haskell-bind/test.hs b/src/runtime/haskell-bind/test.hs
index 16e7ff7cb..26836445f 100644
--- a/src/runtime/haskell-bind/test.hs
+++ b/src/runtime/haskell-bind/test.hs
@@ -5,8 +5,8 @@ main :: IO ()
 main = do
   pgf <- readPGF "/Users/john/repositories/GF/contrib/foods/Foods.pgf"
   let Just concr = M.lookup "FoodsEng" (languages pgf)
-  let pr = complete concr (startCat pgf) "this" "wi" Nothing
+  let pr = complete concr (startCat pgf) "" "th" Nothing
   case pr of
-    ParseOk x -> print (head x)
+    ParseOk x -> print x
     ParseFailed _ _ -> putStrLn "parse failed"
     ParseIncomplete -> putStrLn "input incomplete"