haskell-gi-base 0.20.2 → 0.20.3

raw patch · 7 files changed

+61/−31 lines, 7 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Data/GI/Base/Attributes.hs +4/−1
• Data/GI/Base/BasicTypes.hs +3/−1
• Data/GI/Base/CallStack.hs +2/−1
• Data/GI/Base/ManagedPtr.hs +41/−25
• Data/GI/Base/Signals.hsc +5/−1
• haskell-gi-base.cabal +2/−2

@@ -1,3 +1,7 @@+### 0.20.3+++ Fixes for GHC 8.2.1 (and the corresponding `base-4.10.0`).+ ### 0.20.2  + Fix fromGVariant for empty arrays, see [#91](https://github.com/haskell-gi/haskell-gi/issues/91) for details.

@@ -162,7 +162,10 @@ instance a ~ x => IsLabelProxy x (AttrLabelProxy a) where     fromLabelProxy _ = AttrLabelProxy -#if MIN_VERSION_base(4,9,0)+#if MIN_VERSION_base(4,10,0)+instance a ~ x => IsLabel x (AttrLabelProxy a) where+    fromLabel = AttrLabelProxy+#elif MIN_VERSION_base(4,9,0) instance a ~ x => IsLabel x (AttrLabelProxy a) where     fromLabel _ = AttrLabelProxy #endif

@@ -59,6 +59,7 @@ import GHC.TypeLits #endif +import Data.GI.Base.CallStack (CallStack) import Data.GI.Base.GType  -- | Thin wrapper over `ForeignPtr`, supporting the extra notion of@@ -66,7 +67,8 @@ -- the foreign ptr. data ManagedPtr a = ManagedPtr {       managedForeignPtr :: ForeignPtr a-    , managedPtrIsOwned :: IORef Bool+    , managedPtrIsDisowned :: IORef (Maybe CallStack)+    -- ^ When disowned, the `CallStack` for the disowning call.     }  -- | A constraint ensuring that the given type is coercible to a

@@ -4,12 +4,13 @@ -- functionality itself does not work there). module Data.GI.Base.CallStack   ( HasCallStack+  , CallStack   , prettyCallStack   , callStack   ) where  #if MIN_VERSION_base(4,9,0)-import GHC.Stack (HasCallStack, prettyCallStack, callStack)+import GHC.Stack (HasCallStack, prettyCallStack, callStack, CallStack) #elif MIN_VERSION_base(4,8,1) import Data.List (intercalate) import qualified GHC.Stack as S

@@ -17,6 +17,7 @@     , withManagedPtr     , maybeWithManagedPtr     , withManagedPtrList+    , withTransient     , unsafeManagedPtrGetPtr     , unsafeManagedPtrCastPtr     , touchManagedPtr@@ -49,6 +50,7 @@  import Data.Coerce (coerce) import Data.IORef (newIORef, readIORef, writeIORef, IORef)+import Data.Maybe (isNothing)  import Foreign.C (CInt(..)) import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr)@@ -57,7 +59,8 @@ import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)  import Data.GI.Base.BasicTypes-import Data.GI.Base.CallStack (HasCallStack, prettyCallStack, callStack)+import Data.GI.Base.CallStack (CallStack, HasCallStack,+                               prettyCallStack, callStack) import Data.GI.Base.Utils  import System.IO (hPutStrLn, stderr)@@ -65,15 +68,15 @@ -- | Thin wrapper over `Foreign.Concurrent.newForeignPtr`. newManagedPtr :: Ptr a -> IO () -> IO (ManagedPtr a) newManagedPtr ptr finalizer = do-  let ownedFinalizer :: IORef Bool -> IO ()-      ownedFinalizer boolRef = do-        owned <- readIORef boolRef-        when owned finalizer-  isOwnedRef <- newIORef True-  fPtr <- FC.newForeignPtr ptr (ownedFinalizer isOwnedRef)+  let ownedFinalizer :: IORef (Maybe CallStack) -> IO ()+      ownedFinalizer callStackRef = do+        cs <- readIORef callStackRef+        when (isNothing cs) finalizer+  isDisownedRef <- newIORef Nothing+  fPtr <- FC.newForeignPtr ptr (ownedFinalizer isDisownedRef)   return $ ManagedPtr {                managedForeignPtr = fPtr-             , managedPtrIsOwned = isOwnedRef+             , managedPtrIsDisowned = isDisownedRef              }  foreign import ccall "dynamic"@@ -87,18 +90,21 @@ -- | Thin wrapper over `Foreign.Concurrent.newForeignPtr_`. newManagedPtr_ :: Ptr a -> IO (ManagedPtr a) newManagedPtr_ ptr = do-  isOwnedRef <- newIORef True+  isDisownedRef <- newIORef Nothing   fPtr <- newForeignPtr_ ptr   return $ ManagedPtr {                managedForeignPtr = fPtr-             , managedPtrIsOwned = isOwnedRef+             , managedPtrIsDisowned = isDisownedRef              } --- | Do not run the finalizers upon garbage collection of the `ManagedPtr`.+-- | Do not run the finalizers upon garbage collection of the+-- `ManagedPtr`, for the given reason. If later code tries to access+-- the underlying pointer the given reason will be printed as part of+-- the error message. disownManagedPtr :: forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) disownManagedPtr managed = do   ptr <- unsafeManagedPtrGetPtr managed-  writeIORef (managedPtrIsOwned c) False+  writeIORef (managedPtrIsDisowned c) (Just callStack)   return ptr     where c = coerce managed :: ManagedPtr () @@ -115,11 +121,7 @@ -- `nullPtr` argument. maybeWithManagedPtr :: (HasCallStack, ManagedPtrNewtype a) => Maybe a -> (Ptr a -> IO c) -> IO c maybeWithManagedPtr Nothing action = action nullPtr-maybeWithManagedPtr (Just managed) action = do-  ptr <- unsafeManagedPtrGetPtr managed-  result <- action ptr-  touchManagedPtr managed-  return result+maybeWithManagedPtr (Just managed) action = withManagedPtr managed action  -- | Perform an IO action taking a list of 'Ptr' on a list of managed -- pointers.@@ -130,6 +132,17 @@   mapM_ touchManagedPtr managedList   return result +-- | Perform the IO action with a transient managed pointer. The+-- managed pointer will be valid while calling the action, but will be+-- disowned as soon as the action finished.+withTransient :: (HasCallStack, ManagedPtrNewtype a)+              => (ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b+withTransient constructor ptr action = do+  managed <- constructor <$> newManagedPtr_ ptr+  r <- action managed+  _ <- disownManagedPtr managed+  return r+ -- | Return the 'Ptr' in a given managed pointer. As the name says, -- this is potentially unsafe: the given 'Ptr' may only be used -- /before/ a call to 'touchManagedPtr'. This function is of most@@ -145,16 +158,19 @@ unsafeManagedPtrCastPtr m = do     let c = coerce m :: ManagedPtr ()         ptr = (castPtr . unsafeForeignPtrToPtr . managedForeignPtr) c-    owned <- readIORef (managedPtrIsOwned c)-    when (not owned) (notOwnedWarning ptr)-    return ptr+    disowned <- readIORef (managedPtrIsDisowned c)+    maybe (return ptr) (notOwnedWarning ptr) disowned  -- | Print a warning when we try to access a disowned foreign ptr.-notOwnedWarning :: HasCallStack => Ptr a -> IO ()-notOwnedWarning ptr = do-  hPutStrLn stderr ("Accessing a disowned pointer <" ++ show ptr-                     ++ ">, this may lead to crashes.\n"-                     ++ prettyCallStack callStack)+notOwnedWarning :: HasCallStack => Ptr a -> CallStack -> IO (Ptr a)+notOwnedWarning ptr cs = do+  hPutStrLn stderr ("WARNING: Accessing a disowned pointer <" ++ show ptr+                     ++ ">, this may lead to crashes.\n\n"+                     ++ "• Callstack for the unsafe access to the pointer:\n"+                     ++ prettyCallStack callStack ++ "\n\n"+                     ++ "• The pointer was disowned at:\n"+                     ++ prettyCallStack cs ++ "\n")+  return ptr  -- | Ensure that the 'Ptr' in the given managed pointer is still alive -- (i.e. it has not been garbage collected by the runtime) at the

@@ -71,7 +71,11 @@     => IsLabelProxy slot (SignalProxy object info) where     fromLabelProxy _ = SignalProxy -#if MIN_VERSION_base(4,9,0)+#if MIN_VERSION_base(4,10,0)+instance info ~ ResolveSignal slot object =>+    IsLabel slot (SignalProxy object info) where+    fromLabel = SignalProxy+#elif MIN_VERSION_base(4,9,0) instance info ~ ResolveSignal slot object =>     IsLabel slot (SignalProxy object info) where     fromLabel _ = SignalProxy

@@ -1,5 +1,5 @@ name:                haskell-gi-base-version:             0.20.2+version:             0.20.3 synopsis:            Foundation for libraries generated by haskell-gi description:         Foundation for libraries generated by haskell-gi homepage:            https://github.com/haskell-gi/haskell-gi-base@@ -59,5 +59,5 @@    build-tools:         hsc2hs   cc-options:          -fPIC-  extensions:          CPP, ForeignFunctionInterface, DoAndIfThenElse+  extensions:          CPP, ForeignFunctionInterface, DoAndIfThenElse, MonoLocalBinds   c-sources:           c/hsgclosure.c