started on showPGF

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

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)