From 10e26575de3dcaffd302eb42af3106a9396b2a87 Mon Sep 17 00:00:00 2001
From: krangelov <kr.angelov@gmail.com>
Date: Tue, 16 Nov 2021 12:07:38 +0100
Subject: [PATCH] started on showPGF

---
 src/runtime/c/pgf/pgf.cxx        |  8 ++++++++
 src/runtime/c/pgf/pgf.h          |  3 +++
 src/runtime/haskell/PGF2.hsc     | 14 +++++++++++++-
 src/runtime/haskell/PGF2/FFI.hsc |  2 ++
 4 files changed, 26 insertions(+), 1 deletion(-)

diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx
index fc7dfa3dc..94292877e 100644
--- a/src/runtime/c/pgf/pgf.cxx
+++ b/src/runtime/c/pgf/pgf.cxx
@@ -609,6 +609,14 @@ PgfText *pgf_print_expr(PgfExpr e,
     return printer.get_text();
 }
 
+PGF_API
+PgfText *pgf_print_ident(PgfText *name)
+{
+    PgfPrinter printer(NULL,0,NULL);
+    printer.efun(name);
+    return printer.get_text();
+}
+
 PGF_API
 PgfExpr pgf_read_expr(PgfText *input, PgfUnmarshaller *u)
 {
diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h
index 98125ce95..4b868bae6 100644
--- a/src/runtime/c/pgf/pgf.h
+++ b/src/runtime/c/pgf/pgf.h
@@ -343,6 +343,9 @@ PgfText *pgf_print_expr(PgfExpr e,
                         PgfPrintContext *ctxt, int prio,
                         PgfMarshaller *m);
 
+PGF_API_DECL
+PgfText *pgf_print_ident(PgfText *name);
+
 PGF_API_DECL
 PgfExpr pgf_read_expr(PgfText *input, PgfUnmarshaller *u);
 
diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc
index dbd2a0fff..e44a1d23c 100644
--- a/src/runtime/haskell/PGF2.hsc
+++ b/src/runtime/haskell/PGF2.hsc
@@ -168,7 +168,19 @@ writePGF fpath p =
     withPgfExn "writePGF" (pgf_write_pgf c_fpath (a_db p) c_revision)
 
 showPGF :: PGF -> String
-showPGF = error "TODO: showPGF"
+showPGF p =
+  render (text "abstract" <+> ppAbstractName p <+> char '{' $$
+          nest 4 (ppAbsCats p) $$
+          char '}')
+  where
+    ppAbstractName p =
+      unsafePerformIO $
+      withForeignPtr (a_revision p) $ \c_revision ->
+      bracket (withPgfExn "showPGF" (pgf_abstract_name (a_db p) c_revision)) free $ \c_text ->
+      bracket (pgf_print_ident c_text) free $ \c_text ->
+        fmap text (peekText c_text)
+
+    ppAbsCats p = empty
 
 -- | The abstract language name is the name of the top-level
 -- abstract module
diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc
index d8ef80f84..2a82b7aff 100644
--- a/src/runtime/haskell/PGF2/FFI.hsc
+++ b/src/runtime/haskell/PGF2/FFI.hsc
@@ -80,6 +80,8 @@ foreign import ccall "pgf_abstract_name"
 foreign import ccall "pgf_print_expr"
   pgf_print_expr :: StablePtr Expr -> Ptr PgfPrintContext -> CInt -> Ptr PgfMarshaller -> IO (Ptr PgfText)
 
+foreign import ccall pgf_print_ident :: Ptr PgfText -> IO (Ptr PgfText)
+
 foreign import ccall "pgf_read_expr"
   pgf_read_expr :: Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Expr)