diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -456,47 +456,3 @@ DAMAGES. END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Libraries - - If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms of the -ordinary General Public License). - - To apply these terms, attach the following notices to the library. It is -safest to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the library, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James Random Hacker. - - , 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! diff --git a/haskell-gi-base.cabal b/haskell-gi-base.cabal --- a/haskell-gi-base.cabal +++ b/haskell-gi-base.cabal @@ -1,5 +1,5 @@ name: haskell-gi-base -version: 0.9 +version: 0.10 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 @@ -39,10 +39,13 @@ Data.GI.Base.Utils pkgconfig-depends: gobject-2.0 >= 2.36 - build-depends: base >= 4 && < 5, + build-depends: base >= 4.7 && < 5, bytestring, containers, text >= 1.0 + + if !impl(ghc >= 8.0) + build-depends: transformers build-tools: hsc2hs extensions: CPP, ForeignFunctionInterface, DoAndIfThenElse diff --git a/src/Data/GI/Base/Attributes.hs b/src/Data/GI/Base/Attributes.hs --- a/src/Data/GI/Base/Attributes.hs +++ b/src/Data/GI/Base/Attributes.hs @@ -102,6 +102,8 @@ set ) where +import Control.Monad.IO.Class (MonadIO, liftIO) + import Data.Proxy (Proxy(..)) import Data.GI.Base.GValue (GValue(..)) @@ -215,8 +217,8 @@ proxy (attr :: Symbol) -> (obj -> a -> b) -> AttrOp obj tag -- | Set a number of properties for some object. -set :: forall o. o -> [AttrOp o 'AttrSet] -> IO () -set obj = mapM_ app +set :: forall o m. MonadIO m => o -> [AttrOp o 'AttrSet] -> m () +set obj = liftIO . mapM_ app where resolve :: proxy attr -> Proxy (ResolveAttribute attr o) resolve _ = Proxy @@ -233,9 +235,9 @@ \v -> attrSet (resolve attr) obj (f obj v) -- | Get the value of an attribute for an object. -get :: forall info attr obj proxy. +get :: forall info attr obj proxy m. (info ~ ResolveAttribute attr obj, AttrInfo info, (AttrBaseTypeConstraint info) obj, - AttrOpAllowed 'AttrGet info) => - obj -> proxy (attr :: Symbol) -> IO (AttrGetType info) -get o _ = attrGet (Proxy :: Proxy info) o + AttrOpAllowed 'AttrGet info, MonadIO m) => + obj -> proxy (attr :: Symbol) -> m (AttrGetType info) +get o _ = liftIO $ attrGet (Proxy :: Proxy info) o diff --git a/src/Data/GI/Base/BasicTypes.hsc b/src/Data/GI/Base/BasicTypes.hsc --- a/src/Data/GI/Base/BasicTypes.hsc +++ b/src/Data/GI/Base/BasicTypes.hsc @@ -1,4 +1,5 @@ -{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances #-} +{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances, + DeriveDataTypeable #-} -- | Basic types used in the bindings. module Data.GI.Base.BasicTypes ( @@ -28,6 +29,7 @@ , BoxedObject(..) , BoxedEnum(..) , GObject(..) + , UnexpectedNullPointerReturn(..) -- * Basic GLib \/ GObject types , GVariant(..) @@ -48,7 +50,10 @@ , GDestroyNotify ) where +import Control.Exception (Exception) import Data.Coerce (Coercible) +import qualified Data.Text as T +import Data.Typeable (Typeable) import Data.Word import Foreign.Ptr (Ptr, FunPtr) import Foreign.ForeignPtr (ForeignPtr) @@ -150,6 +155,19 @@ gobjectIsInitiallyUnowned :: a -> Bool -- | The `GType` for this object. gobjectType :: a -> IO GType + +-- | A common omission in the introspection data is missing (nullable) +-- annotations for return types, when they clearly are nullable. (A +-- common idiom is "Returns: valid value, or %NULL if something went +-- wrong.") +-- +-- Haskell wrappers will raise this exception if the return value is +-- an unexpected `Foreign.Ptr.nullPtr`. +data UnexpectedNullPointerReturn = + UnexpectedNullPointerReturn { nullPtrErrorMsg :: T.Text } + deriving (Show, Typeable) + +instance Exception UnexpectedNullPointerReturn -- | A . See "Data.GI.Base.GVariant" for further methods. newtype GVariant = GVariant (ForeignPtr GVariant) diff --git a/src/Data/GI/Base/Properties.hsc b/src/Data/GI/Base/Properties.hsc --- a/src/Data/GI/Base/Properties.hsc +++ b/src/Data/GI/Base/Properties.hsc @@ -74,6 +74,7 @@ import Control.Applicative ((<$>)) #endif import Control.Monad ((>=>)) +import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.ByteString.Char8 as B import Data.Text (Text) @@ -105,9 +106,11 @@ -- | Construct a GObject given the constructor and a list of settable -- attributes. AttrOps are always constructible, so we don't need to -- enforce constraints here. -new :: forall o. GObject o => (ForeignPtr o -> o) -> - [AttrOp o 'AttrConstruct] -> IO o -new constructor attrs = do +new :: forall o m. (GObject o, MonadIO m) + => (ForeignPtr o -> o) + -> [AttrOp o 'AttrConstruct] + -> m o +new constructor attrs = liftIO $ do props <- mapM construct attrs let nprops = length props params <- mallocBytes (nprops*gparameterSize) diff --git a/src/Data/GI/Base/Signals.hsc b/src/Data/GI/Base/Signals.hsc --- a/src/Data/GI/Base/Signals.hsc +++ b/src/Data/GI/Base/Signals.hsc @@ -17,6 +17,8 @@ SignalInfo(..) ) where +import Control.Monad.IO.Class (MonadIO, liftIO) + import Foreign import Foreign.C @@ -58,13 +60,13 @@ -- handler is to be run before the default handler. -- -- > on = connectSignal SignalConnectBefore -on :: forall signal extra o info constraint proxy. +on :: forall signal extra o info constraint proxy m. (GObject o, HasSignal signal o, info ~ ResolveSignal signal o, SignalInfo info, - KnownSymbol extra, constraint o) => + KnownSymbol extra, constraint o, MonadIO m) => o -> proxy (signal :: Symbol) (extra :: Symbol) (constraint :: * -> Constraint) - -> HaskellCallbackType info -> IO SignalHandlerId -on o p c = connectSignal (resolve p) o c SignalConnectBefore + -> HaskellCallbackType info -> m SignalHandlerId +on o p c = liftIO $ connectSignal (resolve p) o c SignalConnectBefore where resolve :: proxy signal extra constraint -> SignalProxy (ResolveSignal signal o) extra constraint resolve _ = SignalProxy @@ -72,13 +74,13 @@ -- | Connect a signal to a handler, running the handler after the default one. -- -- > after = connectSignal SignalConnectAfter -after :: forall signal extra o info constraint proxy. +after :: forall signal extra o info constraint proxy m. (GObject o, HasSignal signal o, info ~ ResolveSignal signal o, SignalInfo info, - KnownSymbol extra, constraint o) => + KnownSymbol extra, constraint o, MonadIO m) => o -> proxy (signal :: Symbol) (extra :: Symbol) (constraint :: * -> Constraint) - -> HaskellCallbackType info -> IO SignalHandlerId -after o p c = connectSignal (resolve p) o c SignalConnectAfter + -> HaskellCallbackType info -> m SignalHandlerId +after o p c = liftIO $ connectSignal (resolve p) o c SignalConnectAfter where resolve :: proxy signal extra constraint -> SignalProxy (ResolveSignal signal o) extra constraint resolve _ = SignalProxy diff --git a/src/Data/GI/Base/Utils.hsc b/src/Data/GI/Base/Utils.hsc --- a/src/Data/GI/Base/Utils.hsc +++ b/src/Data/GI/Base/Utils.hsc @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, TupleSections #-} +{-# LANGUAGE ScopedTypeVariables, TupleSections, OverloadedStrings #-} {- | Assorted utility functions for bindings. -} module Data.GI.Base.Utils ( whenJust @@ -11,6 +11,7 @@ , convertIfNonNull , callocBytes , callocBoxedBytes + , callocMem , allocBytes , allocMem , freeMem @@ -19,6 +20,7 @@ , safeFreeFunPtr , safeFreeFunPtrPtr , maybeReleaseFunPtr + , checkUnexpectedReturnNULL ) where #include @@ -26,8 +28,11 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative (Applicative, pure, (<$>), (<*>)) #endif +import Control.Exception (throwIO) import Control.Monad (void) +import qualified Data.Text as T +import Data.Monoid ((<>)) import Data.Word import Foreign (peek) @@ -35,7 +40,8 @@ import Foreign.Ptr (Ptr, nullPtr, FunPtr, freeHaskellFunPtr) import Foreign.Storable (Storable(..)) -import Data.GI.Base.BasicTypes (GType(..), CGType, BoxedObject(..)) +import Data.GI.Base.BasicTypes (GType(..), CGType, BoxedObject(..), + UnexpectedNullPointerReturn(..)) -- | When the given value is of "Just a" form, execute the given action, -- otherwise do nothing. @@ -92,6 +98,12 @@ callocBytes :: Int -> IO (Ptr a) callocBytes n = g_malloc0 (fromIntegral n) +-- | Make a zero-filled allocation of enough size to hold the given +-- `Storable` type, using the GLib allocator. +{-# INLINE callocMem #-} +callocMem :: forall a. Storable a => IO (Ptr a) +callocMem = g_malloc0 $ (fromIntegral . sizeOf) (undefined :: a) + foreign import ccall "g_boxed_copy" g_boxed_copy :: CGType -> Ptr a -> IO (Ptr a) @@ -154,3 +166,14 @@ maybeReleaseFunPtr (Just f) = do peek f >>= freeHaskellFunPtr freeMem f + +-- | Check that the given pointer is not NULL. If it is, raise a +-- `UnexpectedNullPointerReturn` exception. +checkUnexpectedReturnNULL :: T.Text -> Ptr a -> IO () +checkUnexpectedReturnNULL fnName ptr + | ptr == nullPtr = + throwIO (UnexpectedNullPointerReturn { + nullPtrErrorMsg = "Received unexpected nullPtr in \"" + <> fnName <> "\"." + }) + | otherwise = return ()