module Data.GI.CodeGen.Transfer
( freeInArg
, freeInArgOnError
, freeContainerType
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Monad (when)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import Data.GI.CodeGen.API
import Data.GI.CodeGen.Code
import Data.GI.CodeGen.Conversions
import Data.GI.CodeGen.GObject
import Data.GI.CodeGen.Type
import Data.GI.CodeGen.Util
basicFreeFn :: Type -> Maybe Text
basicFreeFn :: Type -> Maybe Text
basicFreeFn (TBasicType BasicType
TUTF8) = forall a. a -> Maybe a
Just Text
"freeMem"
basicFreeFn (TBasicType BasicType
TFileName) = forall a. a -> Maybe a
Just Text
"freeMem"
basicFreeFn (TBasicType BasicType
_) = forall a. Maybe a
Nothing
basicFreeFn (TInterface Name
_) = forall a. Maybe a
Nothing
basicFreeFn (TCArray Bool
False (-1) (-1) (TBasicType BasicType
TUInt8)) = forall a. Maybe a
Nothing
basicFreeFn (TCArray{}) = forall a. a -> Maybe a
Just Text
"freeMem"
basicFreeFn (TGArray Type
_) = forall a. a -> Maybe a
Just Text
"unrefGArray"
basicFreeFn (TPtrArray Type
_) = forall a. a -> Maybe a
Just Text
"unrefPtrArray"
basicFreeFn (Type
TByteArray) = forall a. a -> Maybe a
Just Text
"unrefGByteArray"
basicFreeFn (TGList Type
_) = forall a. a -> Maybe a
Just Text
"g_list_free"
basicFreeFn (TGSList Type
_) = forall a. a -> Maybe a
Just Text
"g_slist_free"
basicFreeFn (TGHash Type
_ Type
_) = forall a. a -> Maybe a
Just Text
"unrefGHashTable"
basicFreeFn (Type
TError) = forall a. Maybe a
Nothing
basicFreeFn (Type
TVariant) = forall a. Maybe a
Nothing
basicFreeFn (Type
TGValue) = forall a. Maybe a
Nothing
basicFreeFn (Type
TParamSpec) = forall a. Maybe a
Nothing
basicFreeFn (TGClosure Maybe Type
_) = forall a. Maybe a
Nothing
basicFreeFnOnError :: Type -> Transfer -> CodeGen e (Maybe Text)
basicFreeFnOnError :: forall e. Type -> Transfer -> CodeGen e (Maybe Text)
basicFreeFnOnError (TBasicType BasicType
TUTF8) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"freeMem"
basicFreeFnOnError (TBasicType BasicType
TFileName) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"freeMem"
basicFreeFnOnError (TBasicType BasicType
_) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
basicFreeFnOnError Type
TVariant Transfer
transfer =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall a. a -> Maybe a
Just Text
"unrefGVariant"
else forall a. Maybe a
Nothing
basicFreeFnOnError Type
TParamSpec Transfer
transfer =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall a. a -> Maybe a
Just Text
"unrefGParamSpec"
else forall a. Maybe a
Nothing
basicFreeFnOnError Type
TGValue Transfer
transfer =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall a. a -> Maybe a
Just Text
"SP.freeMem"
else forall a. Maybe a
Nothing
basicFreeFnOnError (TGClosure Maybe Type
_) Transfer
transfer =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall a. a -> Maybe a
Just Text
"B.GClosure.unrefGClosure"
else forall a. Maybe a
Nothing
basicFreeFnOnError t :: Type
t@(TInterface Name
_) Transfer
transfer = do
Maybe API
api <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
case Maybe API
api of
Just (APIObject Object
_) -> if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then do
Bool
isGO <- forall e. Type -> CodeGen e Bool
isGObject Type
t
if Bool
isGO
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"unrefObject"
else do
forall e. Text -> CodeGen e ()
line Text
"-- XXX Transfer a non-GObject object"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just (APIInterface Interface
_) -> if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then do
Bool
isGO <- forall e. Type -> CodeGen e Bool
isGObject Type
t
if Bool
isGO
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"unrefObject"
else do
forall e. Text -> CodeGen e ()
line Text
"-- XXX Transfer a non-GObject object"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just (APIUnion Union
u) -> if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then if Union -> Bool
unionIsBoxed Union
u
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"freeBoxed"
else do
forall e. Text -> CodeGen e ()
line Text
"-- XXX Transfer a non-boxed union"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just (APIStruct Struct
s) -> if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then if Struct -> Bool
structIsBoxed Struct
s
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"freeBoxed"
else do
forall e. Text -> CodeGen e ()
line Text
"-- XXX Transfer a non-boxed struct"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe API
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
basicFreeFnOnError (TCArray Bool
False (-1) (-1) (TBasicType BasicType
TUInt8)) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
basicFreeFnOnError (TCArray{}) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"freeMem"
basicFreeFnOnError (TGArray Type
_) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"unrefGArray"
basicFreeFnOnError (TPtrArray Type
_) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"unrefPtrArray"
basicFreeFnOnError (Type
TByteArray) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"unrefGByteArray"
basicFreeFnOnError (TGList Type
_) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"g_list_free"
basicFreeFnOnError (TGSList Type
_) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"g_slist_free"
basicFreeFnOnError (TGHash Type
_ Type
_) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"unrefGHashTable"
basicFreeFnOnError (Type
TError) Transfer
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
freeContainer :: Type -> Text -> CodeGen e [Text]
freeContainer :: forall e. Type -> Text -> CodeGen e [Text]
freeContainer Type
t Text
label =
case Type -> Maybe Text
basicFreeFn Type
t of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Text
fn -> forall (m :: * -> *) a. Monad m => a -> m a
return [Text
fn forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
label]
freeElem :: Type -> Text -> Text -> ExcCodeGen Text
freeElem :: Type -> Text -> Text -> ExcCodeGen Text
freeElem Type
t Text
label Text
free =
case Type -> Text -> Maybe (Type, Text)
elementTypeAndMap Type
t forall a. HasCallStack => a
undefined of
Maybe (Type, Text)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
free
Just (TCArray Bool
False Int
_ Int
_ Type
_, Text
_) ->
forall a. Text -> ExcCodeGen a
badIntroError forall a b. (a -> b) -> a -> b
$ Text
"Element type in container \"" forall a. Semigroup a => a -> a -> a
<> Text
label forall a. Semigroup a => a -> a -> a
<>
Text
"\" is an array of unknown length."
Just (Type
innerType, Text
mapFn) -> do
let elemFree :: Text
elemFree = Text
"freeElemOf" forall a. Semigroup a => a -> a -> a
<> Text -> Text
ucFirst Text
label
Type -> Text -> ExcCodeGen (Maybe Text)
fullyFree Type
innerType (Text -> Text
prime Text
label) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
free forall a. Semigroup a => a -> a -> a
<> Text
" e"
Just Text
elemInnerFree -> do
forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
"let " forall a. Semigroup a => a -> a -> a
<> Text
elemFree forall a. Semigroup a => a -> a -> a
<> Text
" e = " forall a. Semigroup a => a -> a -> a
<> Text
mapFn forall a. Semigroup a => a -> a -> a
<> Text
" "
forall a. Semigroup a => a -> a -> a
<> Text
elemInnerFree forall a. Semigroup a => a -> a -> a
<> Text
" e >> " forall a. Semigroup a => a -> a -> a
<> Text
free forall a. Semigroup a => a -> a -> a
<> Text
" e"
forall (m :: * -> *) a. Monad m => a -> m a
return Text
elemFree
fullyFree :: Type -> Text -> ExcCodeGen (Maybe Text)
fullyFree :: Type -> Text -> ExcCodeGen (Maybe Text)
fullyFree Type
t Text
label = case Type -> Maybe Text
basicFreeFn Type
t of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Text
free -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Text -> Text -> ExcCodeGen Text
freeElem Type
t Text
label Text
free
fullyFreeOnError :: Type -> Text -> Transfer -> ExcCodeGen (Maybe Text)
fullyFreeOnError :: Type -> Text -> Transfer -> ExcCodeGen (Maybe Text)
fullyFreeOnError Type
t Text
label Transfer
transfer =
forall e. Type -> Transfer -> CodeGen e (Maybe Text)
basicFreeFnOnError Type
t Transfer
transfer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Text
free -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Text -> Text -> ExcCodeGen Text
freeElem Type
t Text
label Text
free
freeElements :: Type -> Text -> Text -> ExcCodeGen [Text]
freeElements :: Type -> Text -> Text -> ExcCodeGen [Text]
freeElements Type
t Text
label Text
len =
case Type -> Text -> Maybe (Type, Text)
elementTypeAndMap Type
t Text
len of
Maybe (Type, Text)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (Type
inner, Text
mapFn) ->
Type -> Text -> ExcCodeGen (Maybe Text)
fullyFree Type
inner Text
label forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Text
innerFree ->
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
mapFn forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
innerFree forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
label]
freeContainerType :: Transfer -> Type -> Text -> Text -> ExcCodeGen ()
freeContainerType :: Transfer -> Type -> Text -> Text -> CodeGen CGError ()
freeContainerType Transfer
transfer (TGHash Type
_ Type
_) Text
label Text
_ = Transfer -> Text -> CodeGen CGError ()
freeGHashTable Transfer
transfer Text
label
freeContainerType Transfer
transfer Type
t Text
label Text
len = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall e. Text -> CodeGen e ()
line forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> Text -> Text -> ExcCodeGen [Text]
freeElements Type
t Text
label Text
len
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Transfer
transfer forall a. Eq a => a -> a -> Bool
/= Transfer
TransferNothing) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall e. Text -> CodeGen e ()
line forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. Type -> Text -> CodeGen e [Text]
freeContainer Type
t Text
label
freeGHashTable :: Transfer -> Text -> ExcCodeGen ()
freeGHashTable :: Transfer -> Text -> CodeGen CGError ()
freeGHashTable Transfer
TransferNothing Text
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
freeGHashTable Transfer
TransferContainer Text
label =
forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$ Text
"Hash table argument with transfer = Container? "
forall a. Semigroup a => a -> a -> a
<> Text
label
freeGHashTable Transfer
TransferEverything Text
label =
forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
"unrefGHashTable " forall a. Semigroup a => a -> a -> a
<> Text
label
freeElementsOnError :: Transfer -> Type -> Text -> Text ->
ExcCodeGen [Text]
freeElementsOnError :: Transfer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeElementsOnError Transfer
transfer Type
t Text
label Text
len =
case Type -> Text -> Maybe (Type, Text)
elementTypeAndMap Type
t Text
len of
Maybe (Type, Text)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (Type
inner, Text
mapFn) ->
Type -> Text -> Transfer -> ExcCodeGen (Maybe Text)
fullyFreeOnError Type
inner Text
label Transfer
transfer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Text
innerFree ->
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
mapFn forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
innerFree forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
label]
freeIn :: Transfer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeIn :: Transfer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeIn Transfer
transfer (TGHash Type
_ Type
_) Text
label Text
_ =
Transfer -> Text -> ExcCodeGen [Text]
freeInGHashTable Transfer
transfer Text
label
freeIn Transfer
transfer Type
t Text
label Text
len =
case Transfer
transfer of
Transfer
TransferNothing -> forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Text -> Text -> ExcCodeGen [Text]
freeElements Type
t Text
label Text
len forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e. Type -> Text -> CodeGen e [Text]
freeContainer Type
t Text
label
Transfer
TransferContainer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeElements Type
t Text
label Text
len
Transfer
TransferEverything -> forall (m :: * -> *) a. Monad m => a -> m a
return []
freeInOnError :: Transfer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeInOnError :: Transfer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeInOnError Transfer
transfer (TGHash Type
_ Type
_) Text
label Text
_ =
Transfer -> Text -> ExcCodeGen [Text]
freeInGHashTable Transfer
transfer Text
label
freeInOnError Transfer
transfer Type
t Text
label Text
len =
forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transfer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeElementsOnError Transfer
transfer Type
t Text
label Text
len
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e. Type -> Text -> CodeGen e [Text]
freeContainer Type
t Text
label
freeInGHashTable :: Transfer -> Text -> ExcCodeGen [Text]
freeInGHashTable :: Transfer -> Text -> ExcCodeGen [Text]
freeInGHashTable Transfer
TransferEverything Text
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
freeInGHashTable Transfer
TransferContainer Text
label =
forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$ Text
"Hash table argument with TransferContainer? "
forall a. Semigroup a => a -> a -> a
<> Text
label
freeInGHashTable Transfer
TransferNothing Text
label = forall (m :: * -> *) a. Monad m => a -> m a
return [Text
"unrefGHashTable " forall a. Semigroup a => a -> a -> a
<> Text
label]
freeOut :: Text -> CodeGen e [Text]
freeOut :: forall e. Text -> CodeGen e [Text]
freeOut Text
label = forall (m :: * -> *) a. Monad m => a -> m a
return [Text
"freeMem " forall a. Semigroup a => a -> a -> a
<> Text
label]
freeInArg :: Arg -> Text -> Text -> ExcCodeGen [Text]
freeInArg :: Arg -> Text -> Text -> ExcCodeGen [Text]
freeInArg Arg
arg Text
label Text
len = do
if Arg -> Bool
willWrap Arg
arg
then forall (m :: * -> *) a. Monad m => a -> m a
return []
else case Arg -> Direction
direction Arg
arg of
Direction
DirectionIn -> Transfer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeIn (Arg -> Transfer
transfer Arg
arg) (Arg -> Type
argType Arg
arg) Text
label Text
len
Direction
DirectionOut -> forall e. Text -> CodeGen e [Text]
freeOut Text
label
Direction
DirectionInout -> forall e. Text -> CodeGen e [Text]
freeOut Text
label
where willWrap :: Arg -> Bool
willWrap :: Arg -> Bool
willWrap = Arg -> Bool
argCallerAllocates
freeInArgOnError :: Arg -> Text -> Text -> ExcCodeGen [Text]
freeInArgOnError :: Arg -> Text -> Text -> ExcCodeGen [Text]
freeInArgOnError Arg
arg Text
label Text
len =
case Arg -> Direction
direction Arg
arg of
Direction
DirectionIn -> Transfer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeInOnError (Arg -> Transfer
transfer Arg
arg) (Arg -> Type
argType Arg
arg) Text
label Text
len
Direction
DirectionOut -> forall e. Text -> CodeGen e [Text]
freeOut Text
label
Direction
DirectionInout ->
if Arg -> Bool
argCallerAllocates Arg
arg
then Transfer -> Type -> Text -> Text -> ExcCodeGen [Text]
freeInOnError (Arg -> Transfer
transfer Arg
arg) (Arg -> Type
argType Arg
arg) Text
label Text
len
else forall e. Text -> CodeGen e [Text]
freeOut Text
label