msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

if createConcrete/alterConcrete fail, report the error correctly

Browse Source
This commit is contained in:
Krasimir Angelov
2023-03-01 15:24:30 +01:00
parent c9a83e496c
commit 91769c7ff2
1 changed files with 13 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
src/runtime/haskell/PGF2/Transactions.hsc
View File

@@ -184,17 +184,26 @@ dropCategory name = Transaction $ \c_db _ c_revision c_exn ->
createConcrete :: ConcName -> Transaction Concr () -> Transaction PGF () createConcrete :: ConcName -> Transaction Concr () -> Transaction PGF ()
createConcrete name (Transaction f) = Transaction $ \c_db c_abstr c_revision c_exn -> createConcrete name (Transaction f) = Transaction $ \c_db c_abstr c_revision c_exn ->
withText name $ \c_name -> do withText name $ \c_name -> do
bracket (pgf_create_concrete c_db c_revision c_name c_exn) bracketPtr (pgf_create_concrete c_db c_revision c_name c_exn)
(pgf_free_concr_revision_ c_db) $ \c_concr_revision -> (pgf_free_concr_revision_ c_db) $ \c_concr_revision ->
f c_db c_abstr c_concr_revision c_exn f c_db c_abstr c_concr_revision c_exn
alterConcrete :: ConcName -> Transaction Concr a -> Transaction PGF a alterConcrete :: ConcName -> Transaction Concr a -> Transaction PGF a
alterConcrete name (Transaction f) = Transaction $ \c_db c_abstr c_revision c_exn -> alterConcrete name (Transaction f) = Transaction $ \c_db c_abstr c_revision c_exn ->
withText name $ \c_name -> do withText name $ \c_name -> do
bracket (pgf_clone_concrete c_db c_revision c_name c_exn) bracketPtr (pgf_clone_concrete c_db c_revision c_name c_exn)
(pgf_free_concr_revision_ c_db) $ \c_concr_revision -> (pgf_free_concr_revision_ c_db) $ \c_concr_revision ->
f c_db c_abstr c_concr_revision c_exn f c_db c_abstr c_concr_revision c_exn
bracketPtr before after thing =
mask $ \restore -> do
a <- before
if a == nullPtr
then return undefined
else do r <- restore (thing a) `onException` after a
_ <- after a
return r
dropConcrete :: ConcName -> Transaction PGF () dropConcrete :: ConcName -> Transaction PGF ()
dropConcrete name = Transaction $ \c_db _ c_revision c_exn -> dropConcrete name = Transaction $ \c_db _ c_revision c_exn ->
withText name $ \c_name -> do withText name $ \c_name -> do