{-# LINE 1 "lib/Data/GI/CodeGen/Conversions.hsc" #-}
{-# LANGUAGE PatternGuards, DeriveFunctor #-}
module Data.GI.CodeGen.Conversions
( convert
, genConversion
, unpackCArray
, computeArrayLength
, callableHasClosures
, hToF
, fToH
, transientToH
, haskellType
, isoHaskellType
, foreignType
, argumentType
, ExposeClosures(..)
, elementType
, elementMap
, elementTypeAndMap
, isManaged
, typeIsNullable
, typeIsPtr
, typeIsCallback
, maybeNullConvert
, nullPtrForType
, typeAllocInfo
, TypeAllocInfo(..)
, apply
, mapC
, literal
, Constructor(..)
) where
{-# LINE 45 "lib/Data/GI/CodeGen/Conversions.hsc" #-}
import Control.Monad (when)
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Exts (IsString(..))
import Foreign.C.Types (CInt, CUInt)
import Foreign.Storable (sizeOf)
import Data.GI.CodeGen.API
import Data.GI.CodeGen.Code
import Data.GI.CodeGen.GObject
import Data.GI.CodeGen.SymbolNaming
import Data.GI.CodeGen.Type
import Data.GI.CodeGen.Util
data Free f r = Free (f (Free f r)) | Pure r
instance Functor f => Functor (Free f) where
fmap :: forall a b. (a -> b) -> Free f a -> Free f b
fmap a -> b
f = forall {f :: * -> *}. Functor f => Free f a -> Free f b
go where
go :: Free f a -> Free f b
go (Pure a
a) = forall (f :: * -> *) r. r -> Free f r
Pure (a -> b
f a
a)
go (Free f (Free f a)
fa) = forall (f :: * -> *) r. f (Free f r) -> Free f r
Free (Free f a -> Free f b
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Free f a)
fa)
instance (Functor f) => Applicative (Free f) where
pure :: forall a. a -> Free f a
pure = forall (f :: * -> *) r. r -> Free f r
Pure
Pure a -> b
a <*> :: forall a b. Free f (a -> b) -> Free f a -> Free f b
<*> Pure a
b = forall (f :: * -> *) r. r -> Free f r
Pure forall a b. (a -> b) -> a -> b
$ a -> b
a a
b
Pure a -> b
a <*> Free f (Free f a)
mb = forall (f :: * -> *) r. f (Free f r) -> Free f r
Free forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Free f a)
mb
Free f (Free f (a -> b))
ma <*> Free f a
b = forall (f :: * -> *) r. f (Free f r) -> Free f r
Free forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Free f a
b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Free f (a -> b))
ma
instance (Functor f) => Monad (Free f) where
(Free f (Free f a)
x) >>= :: forall a b. Free f a -> (a -> Free f b) -> Free f b
>>= a -> Free f b
f = forall (f :: * -> *) r. f (Free f r) -> Free f r
Free (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Free f b
f) f (Free f a)
x)
(Pure a
r) >>= a -> Free f b
f = a -> Free f b
f a
r
liftF :: (Functor f) => f r -> Free f r
liftF :: forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF f r
command = forall (f :: * -> *) r. f (Free f r) -> Free f r
Free (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) r. r -> Free f r
Pure f r
command)
data Constructor = P Text | M Text | Id
deriving (Constructor -> Constructor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constructor -> Constructor -> Bool
$c/= :: Constructor -> Constructor -> Bool
== :: Constructor -> Constructor -> Bool
$c== :: Constructor -> Constructor -> Bool
Eq,Int -> Constructor -> ShowS
[Constructor] -> ShowS
Constructor -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Constructor] -> ShowS
$cshowList :: [Constructor] -> ShowS
show :: Constructor -> [Char]
$cshow :: Constructor -> [Char]
showsPrec :: Int -> Constructor -> ShowS
$cshowsPrec :: Int -> Constructor -> ShowS
Show)
instance IsString Constructor where
fromString :: [Char] -> Constructor
fromString = Text -> Constructor
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
data FExpr next = Apply Constructor next
| LambdaConvert Text next
| MapC Map Constructor next
| Literal Constructor next
deriving (Int -> FExpr next -> ShowS
forall next. Show next => Int -> FExpr next -> ShowS
forall next. Show next => [FExpr next] -> ShowS
forall next. Show next => FExpr next -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FExpr next] -> ShowS
$cshowList :: forall next. Show next => [FExpr next] -> ShowS
show :: FExpr next -> [Char]
$cshow :: forall next. Show next => FExpr next -> [Char]
showsPrec :: Int -> FExpr next -> ShowS
$cshowsPrec :: forall next. Show next => Int -> FExpr next -> ShowS
Show, forall a b. a -> FExpr b -> FExpr a
forall a b. (a -> b) -> FExpr a -> FExpr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FExpr b -> FExpr a
$c<$ :: forall a b. a -> FExpr b -> FExpr a
fmap :: forall a b. (a -> b) -> FExpr a -> FExpr b
$cfmap :: forall a b. (a -> b) -> FExpr a -> FExpr b
Functor)
type Converter = Free FExpr ()
data Map = Map | MapFirst | MapSecond
deriving (Int -> Map -> ShowS
[Map] -> ShowS
Map -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Map] -> ShowS
$cshowList :: [Map] -> ShowS
show :: Map -> [Char]
$cshow :: Map -> [Char]
showsPrec :: Int -> Map -> ShowS
$cshowsPrec :: Int -> Map -> ShowS
Show)
mapName :: Map -> Text
mapName :: Map -> Text
mapName Map
Map = Text
"map"
mapName Map
MapFirst = Text
"mapFirst"
mapName Map
MapSecond = Text
"mapSecond"
monadicMapName :: Map -> Text
monadicMapName :: Map -> Text
monadicMapName Map
Map = Text
"mapM"
monadicMapName Map
MapFirst = Text
"mapFirstA"
monadicMapName Map
MapSecond = Text
"mapSecondA"
apply :: Constructor -> Converter
apply :: Constructor -> Converter
apply Constructor
f = forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF forall a b. (a -> b) -> a -> b
$ forall next. Constructor -> next -> FExpr next
Apply Constructor
f ()
mapC :: Constructor -> Converter
mapC :: Constructor -> Converter
mapC Constructor
f = forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF forall a b. (a -> b) -> a -> b
$ forall next. Map -> Constructor -> next -> FExpr next
MapC Map
Map Constructor
f ()
mapFirst :: Constructor -> Converter
mapFirst :: Constructor -> Converter
mapFirst Constructor
f = forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF forall a b. (a -> b) -> a -> b
$ forall next. Map -> Constructor -> next -> FExpr next
MapC Map
MapFirst Constructor
f ()
mapSecond :: Constructor -> Converter
mapSecond :: Constructor -> Converter
mapSecond Constructor
f = forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF forall a b. (a -> b) -> a -> b
$ forall next. Map -> Constructor -> next -> FExpr next
MapC Map
MapSecond Constructor
f ()
literal :: Constructor -> Converter
literal :: Constructor -> Converter
literal Constructor
f = forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF forall a b. (a -> b) -> a -> b
$ forall next. Constructor -> next -> FExpr next
Literal Constructor
f ()
lambdaConvert :: Text -> Converter
lambdaConvert :: Text -> Converter
lambdaConvert Text
c = forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF forall a b. (a -> b) -> a -> b
$ forall next. Text -> next -> FExpr next
LambdaConvert Text
c ()
genConversion :: Text -> Converter -> CodeGen e Text
genConversion :: forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l (Pure ()) = forall (m :: * -> *) a. Monad m => a -> m a
return Text
l
genConversion Text
l (Free FExpr Converter
k) = do
let l' :: Text
l' = Text -> Text
prime Text
l
case FExpr Converter
k of
Apply (P Text
f) Converter
next ->
do forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
"let " forall a. Semigroup a => a -> a -> a
<> Text
l' forall a. Semigroup a => a -> a -> a
<> Text
" = " forall a. Semigroup a => a -> a -> a
<> Text
f forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
l
forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l' Converter
next
Apply (M Text
f) Converter
next ->
do forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
l' forall a. Semigroup a => a -> a -> a
<> Text
" <- " forall a. Semigroup a => a -> a -> a
<> Text
f forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
l
forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l' Converter
next
Apply Constructor
Id Converter
next -> forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l Converter
next
MapC Map
m (P Text
f) Converter
next ->
do forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
"let " forall a. Semigroup a => a -> a -> a
<> Text
l' forall a. Semigroup a => a -> a -> a
<> Text
" = " forall a. Semigroup a => a -> a -> a
<> Map -> Text
mapName Map
m forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
f forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
l
forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l' Converter
next
MapC Map
m (M Text
f) Converter
next ->
do forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
l' forall a. Semigroup a => a -> a -> a
<> Text
" <- " forall a. Semigroup a => a -> a -> a
<> Map -> Text
monadicMapName Map
m forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
f forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
l
forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l' Converter
next
MapC Map
_ Constructor
Id Converter
next -> forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l Converter
next
LambdaConvert Text
conv Converter
next ->
do forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
conv forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
l forall a. Semigroup a => a -> a -> a
<> Text
" $ \\" forall a. Semigroup a => a -> a -> a
<> Text
l' forall a. Semigroup a => a -> a -> a
<> Text
" -> do"
forall e. CodeGen e ()
increaseIndent
forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l' Converter
next
Literal (P Text
f) Converter
next ->
do forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
"let " forall a. Semigroup a => a -> a -> a
<> Text
l forall a. Semigroup a => a -> a -> a
<> Text
" = " forall a. Semigroup a => a -> a -> a
<> Text
f
forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l Converter
next
Literal (M Text
f) Converter
next ->
do forall e. Text -> CodeGen e ()
line forall a b. (a -> b) -> a -> b
$ Text
l forall a. Semigroup a => a -> a -> a
<> Text
" <- " forall a. Semigroup a => a -> a -> a
<> Text
f
forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l Converter
next
Literal Constructor
Id Converter
next -> forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l Converter
next
computeArrayLength :: Text -> Type -> ExcCodeGen Text
computeArrayLength :: Text -> Type -> ExcCodeGen Text
computeArrayLength Text
array (TCArray Bool
_ Int
_ Int
_ Type
t) = do
Text
reader <- ExcCodeGen Text
findReader
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"fromIntegral $ " forall a. Semigroup a => a -> a -> a
<> Text
reader forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
array
where findReader :: ExcCodeGen Text
findReader = case Type
t of
TBasicType BasicType
TUInt8 -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"B.length"
Type
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"P.length"
computeArrayLength Text
_ Type
t =
forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$ Text
"computeArrayLength called on non-CArray type "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t
convert :: Text -> CodeGen e Converter -> CodeGen e Text
convert :: forall e. Text -> CodeGen e Converter -> CodeGen e Text
convert Text
l CodeGen e Converter
c = do
Converter
c' <- CodeGen e Converter
c
forall e. Text -> Converter -> CodeGen e Text
genConversion Text
l Converter
c'
hObjectToF :: Type -> Transfer -> ExcCodeGen Constructor
hObjectToF :: Type -> Transfer -> ExcCodeGen Constructor
hObjectToF Type
t Transfer
transfer =
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
$ Text -> Constructor
M Text
"B.ManagedPtr.disownObject"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.ManagedPtr.disownManagedPtr"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrCastPtr"
hVariantToF :: Transfer -> CodeGen e Constructor
hVariantToF :: forall e. Transfer -> CodeGen e Constructor
hVariantToF Transfer
transfer =
if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GVariant.disownGVariant"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"
hValueToF :: Transfer -> CodeGen e Constructor
hValueToF :: forall e. Transfer -> CodeGen e Constructor
hValueToF Transfer
transfer =
if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GValue.disownGValue"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"
hParamSpecToF :: Transfer -> CodeGen e Constructor
hParamSpecToF :: forall e. Transfer -> CodeGen e Constructor
hParamSpecToF Transfer
transfer =
if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GParamSpec.disownGParamSpec"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"
hClosureToF :: Transfer -> Maybe Type -> CodeGen e Constructor
hClosureToF :: forall e. Transfer -> Maybe Type -> CodeGen e Constructor
hClosureToF Transfer
transfer Maybe Type
Nothing =
if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GClosure.disownGClosure"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrCastPtr"
hClosureToF Transfer
transfer (Just Type
_) =
if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GClosure.disownGClosure"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"
hBoxedToF :: Transfer -> CodeGen e Constructor
hBoxedToF :: forall e. Transfer -> CodeGen e Constructor
hBoxedToF Transfer
transfer =
if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.ManagedPtr.disownBoxed"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"
hStructToF :: Struct -> Transfer -> ExcCodeGen Constructor
hStructToF :: Struct -> Transfer -> ExcCodeGen Constructor
hStructToF Struct
s Transfer
transfer =
if Transfer
transfer forall a. Eq a => a -> a -> Bool
/= Transfer
TransferEverything Bool -> Bool -> Bool
|| Struct -> Bool
structIsBoxed Struct
s then
forall e. Transfer -> CodeGen e Constructor
hBoxedToF Transfer
transfer
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Struct -> Int
structSize Struct
s forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
forall a. Text -> ExcCodeGen a
badIntroError Text
"Transferring a non-boxed struct with unknown size!"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"
hUnionToF :: Union -> Transfer -> ExcCodeGen Constructor
hUnionToF :: Union -> Transfer -> ExcCodeGen Constructor
hUnionToF Union
u Transfer
transfer =
if Transfer
transfer forall a. Eq a => a -> a -> Bool
/= Transfer
TransferEverything Bool -> Bool -> Bool
|| Union -> Bool
unionIsBoxed Union
u then
forall e. Transfer -> CodeGen e Constructor
hBoxedToF Transfer
transfer
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Union -> Int
unionSize Union
u forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
forall a. Text -> ExcCodeGen a
badIntroError Text
"Transferring a non-boxed union with unknown size!"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"
hToF' :: Type -> Maybe API -> TypeRep -> TypeRep -> Transfer
-> ExcCodeGen Constructor
hToF' :: Type
-> Maybe API
-> TypeRep
-> TypeRep
-> Transfer
-> ExcCodeGen Constructor
hToF' Type
t Maybe API
a TypeRep
hType TypeRep
fType Transfer
transfer
| ( TypeRep
hType forall a. Eq a => a -> a -> Bool
== TypeRep
fType ) = forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
Id
| Type
TError <- Type
t = forall e. Transfer -> CodeGen e Constructor
hBoxedToF Transfer
transfer
| Type
TVariant <- Type
t = forall e. Transfer -> CodeGen e Constructor
hVariantToF Transfer
transfer
| Type
TGValue <- Type
t = forall e. Transfer -> CodeGen e Constructor
hValueToF Transfer
transfer
| Type
TParamSpec <- Type
t = forall e. Transfer -> CodeGen e Constructor
hParamSpecToF Transfer
transfer
| TGClosure Maybe Type
c <- Type
t = forall e. Transfer -> Maybe Type -> CodeGen e Constructor
hClosureToF Transfer
transfer Maybe Type
c
| Just (APIEnum Enumeration
_) <- Maybe API
a = forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(fromIntegral . fromEnum)"
| Just (APIFlags Flags
_) <- Maybe API
a = forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"gflagsToWord"
| Just (APIObject Object
_) <- Maybe API
a = Type -> Transfer -> ExcCodeGen Constructor
hObjectToF Type
t Transfer
transfer
| Just (APIInterface Interface
_) <- Maybe API
a = Type -> Transfer -> ExcCodeGen Constructor
hObjectToF Type
t Transfer
transfer
| Just (APIStruct Struct
s) <- Maybe API
a = Struct -> Transfer -> ExcCodeGen Constructor
hStructToF Struct
s Transfer
transfer
| Just (APIUnion Union
u) <- Maybe API
a = Union -> Transfer -> ExcCodeGen Constructor
hUnionToF Union
u Transfer
transfer
| Just (APICallback Callback
_) <- Maybe API
a = forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot handle callback type here!! "
| Type
TByteArray <- Type
t = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packGByteArray"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TUTF8) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedUTF8CArray"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TFileName) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedFileNameArray"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TPtr) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedPtrArray"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TUInt8) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedByteString"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TBoolean) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapZeroTerminatedStorableArray (fromIntegral . fromEnum))"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TGType) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapZeroTerminatedStorableArray gtypeToCGtype)"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
_) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedStorableArray"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TUTF8) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packUTF8CArray"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TFileName) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packFileNameArray"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TPtr) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packPtrArray"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TUInt8) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packByteString"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TBoolean) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapStorableArray (P.fromIntegral . P.fromEnum))"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TGType) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapStorableArray gtypeToCGType)"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TFloat) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapStorableArray realToFrac)"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TDouble) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapStorableArray realToFrac)"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TUniChar) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapStorableArray (P.fromIntegral . SP.ord))"
| TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
_) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packStorableArray"
| TCArray Bool
False Int
_ Int
_ Type
TGValue <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GValue.packGValueArray"
| TCArray{} <- Type
t = forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$
Text
"Don't know how to pack C array of type " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t
| Bool
otherwise = case (TypeRep -> Text
typeShow TypeRep
hType, TypeRep -> Text
typeShow TypeRep
fType) of
(Text
"T.Text", Text
"CString") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"textToCString"
(Text
"[Char]", Text
"CString") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"stringToCString"
(Text
"Char", Text
"CInt") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(P.fromIntegral . SP.ord)"
(Text
"Bool", Text
"CInt") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(P.fromIntegral . P.fromEnum)"
(Text
"Float", Text
"CFloat") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"realToFrac"
(Text
"Double", Text
"CDouble") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"realToFrac"
(Text
"GType", Text
"CGType") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"gtypeToCGType"
(Text, Text)
_ -> forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$
Text
"Don't know how to convert "
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
typeShow TypeRep
hType forall a. Semigroup a => a -> a -> a
<> Text
" into "
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
typeShow TypeRep
fType forall a. Semigroup a => a -> a -> a
<> Text
".\n"
forall a. Semigroup a => a -> a -> a
<> Text
"Internal type: "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t
getForeignConstructor :: Type -> Transfer -> ExcCodeGen Constructor
getForeignConstructor :: Type -> Transfer -> ExcCodeGen Constructor
getForeignConstructor Type
t Transfer
transfer = do
Maybe API
a <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
TypeRep
hType <- forall e. Type -> CodeGen e TypeRep
haskellType Type
t
TypeRep
fType <- forall e. Type -> CodeGen e TypeRep
foreignType Type
t
Type
-> Maybe API
-> TypeRep
-> TypeRep
-> Transfer
-> ExcCodeGen Constructor
hToF' Type
t Maybe API
a TypeRep
hType TypeRep
fType Transfer
transfer
hToF_PackedType :: Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType :: Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t Text
packer Transfer
transfer = do
Constructor
innerConstructor <- Type -> Transfer -> ExcCodeGen Constructor
getForeignConstructor Type
t Transfer
transfer
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
Constructor -> Converter
mapC Constructor
innerConstructor
Constructor -> Converter
apply (Text -> Constructor
M Text
packer)
hashTableKeyMappings :: Type -> ExcCodeGen (Text, Text)
hashTableKeyMappings :: Type -> ExcCodeGen (Text, Text)
hashTableKeyMappings (TBasicType BasicType
TPtr) = forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"gDirectHash", Text
"gDirectEqual")
hashTableKeyMappings (TBasicType BasicType
TUTF8) = forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"gStrHash", Text
"gStrEqual")
hashTableKeyMappings Type
t =
forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$ Text
"GHashTable key of type " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t forall a. Semigroup a => a -> a -> a
<> Text
" unsupported."
hashTablePtrPackers :: Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers :: Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers (TBasicType BasicType
TPtr) =
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"Nothing", Text
"B.GHT.ptrPackPtr", Text
"B.GHT.ptrUnpackPtr")
hashTablePtrPackers (TBasicType BasicType
TUTF8) =
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"(Just ptr_to_g_free)", Text
"B.GHT.cstringPackPtr", Text
"B.GHT.cstringUnpackPtr")
hashTablePtrPackers Type
TGValue =
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"(Just B.GValue.ptr_to_gvalue_free)", Text
"B.GHT.gvaluePackPtr",
Text
"B.GHT.gvalueUnpackPtr")
hashTablePtrPackers Type
t =
forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$ Text
"GHashTable element of type " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t forall a. Semigroup a => a -> a -> a
<> Text
" unsupported."
hToF_PackGHashTable :: Type -> Type -> ExcCodeGen Converter
hToF_PackGHashTable :: Type -> Type -> ExcCodeGen Converter
hToF_PackGHashTable Type
keys Type
elems = do
Constructor
keysConstructor <- Type -> Transfer -> ExcCodeGen Constructor
getForeignConstructor Type
keys Transfer
TransferEverything
Constructor
elemsConstructor <- Type -> Transfer -> ExcCodeGen Constructor
getForeignConstructor Type
elems Transfer
TransferEverything
(Text
keyHash, Text
keyEqual) <- Type -> ExcCodeGen (Text, Text)
hashTableKeyMappings Type
keys
(Text
keyDestroy, Text
keyPack, Text
_) <- Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers Type
keys
(Text
elemDestroy, Text
elemPack, Text
_) <- Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers Type
elems
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
Constructor -> Converter
apply (Text -> Constructor
P Text
"Map.toList")
Constructor -> Converter
mapFirst Constructor
keysConstructor
Constructor -> Converter
mapSecond Constructor
elemsConstructor
Constructor -> Converter
mapFirst (Text -> Constructor
P Text
keyPack)
Constructor -> Converter
mapSecond (Text -> Constructor
P Text
elemPack)
Constructor -> Converter
apply (Text -> Constructor
M (Text -> [Text] -> Text
T.intercalate Text
" " [Text
"packGHashTable", Text
keyHash, Text
keyEqual,
Text
keyDestroy, Text
elemDestroy]))
hToF :: Type -> Transfer -> ExcCodeGen Converter
hToF :: Type -> Transfer -> ExcCodeGen Converter
hToF (TGList Type
t) Transfer
transfer = do
Bool
isPtr <- forall e. Type -> CodeGen e Bool
typeIsPtr Type
t
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isPtr) forall a b. (a -> b) -> a -> b
$
forall a. Text -> ExcCodeGen a
badIntroError (Text
"'" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t forall a. Semigroup a => a -> a -> a
<>
Text
"' is not a pointer type, cannot pack into a GList.")
Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t Text
"packGList" Transfer
transfer
hToF (TGSList Type
t) Transfer
transfer = do
Bool
isPtr <- forall e. Type -> CodeGen e Bool
typeIsPtr Type
t
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isPtr) forall a b. (a -> b) -> a -> b
$
forall a. Text -> ExcCodeGen a
badIntroError (Text
"'" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t forall a. Semigroup a => a -> a -> a
<>
Text
"' is not a pointer type, cannot pack into a GSList.")
Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t Text
"packGSList" Transfer
transfer
hToF (TGArray Type
t) Transfer
transfer = Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t Text
"packGArray" Transfer
transfer
hToF (TPtrArray Type
t) Transfer
transfer = Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t Text
"packGPtrArray" Transfer
transfer
hToF (TGHash Type
ta Type
tb) Transfer
_ = Type -> Type -> ExcCodeGen Converter
hToF_PackGHashTable Type
ta Type
tb
hToF (TCArray Bool
zt Int
_ Int
_ t :: Type
t@(TCArray{})) Transfer
transfer = do
let packer :: Text
packer = if Bool
zt
then Text
"packZeroTerminated"
else Text
"pack"
Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t (Text
packer forall a. Semigroup a => a -> a -> a
<> Text
"PtrArray") Transfer
transfer
hToF (TCArray Bool
zt Int
_ Int
_ t :: Type
t@(TInterface Name
_)) Transfer
transfer = do
Bool
isScalar <- forall e. Type -> CodeGen e Bool
typeIsEnumOrFlag Type
t
let packer :: Text
packer = if Bool
zt
then Text
"packZeroTerminated"
else Text
"pack"
if Bool
isScalar
then Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t (Text
packer forall a. Semigroup a => a -> a -> a
<> Text
"StorableArray") Transfer
transfer
else do
Maybe API
api <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
let size :: Int
size = case Maybe API
api of
Just (APIStruct Struct
s) -> Struct -> Int
structSize Struct
s
Just (APIUnion Union
u) -> Union -> Int
unionSize Union
u
Maybe API
_ -> Int
0
if Int
size forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bool
zt
then Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t (Text
packer forall a. Semigroup a => a -> a -> a
<> Text
"PtrArray") Transfer
transfer
else Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t (Text
packer forall a. Semigroup a => a -> a -> a
<> Text
"BlockArray " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
size) Transfer
transfer
hToF Type
t Transfer
transfer = do
Maybe API
a <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
TypeRep
hType <- forall e. Type -> CodeGen e TypeRep
haskellType Type
t
TypeRep
fType <- forall e. Type -> CodeGen e TypeRep
foreignType Type
t
Constructor
constructor <- Type
-> Maybe API
-> TypeRep
-> TypeRep
-> Transfer
-> ExcCodeGen Constructor
hToF' Type
t Maybe API
a TypeRep
hType TypeRep
fType Transfer
transfer
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply Constructor
constructor
boxedForeignPtr :: Text -> Transfer -> CodeGen e Constructor
boxedForeignPtr :: forall e. Text -> Transfer -> CodeGen e Constructor
boxedForeignPtr Text
constructor Transfer
transfer = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case Transfer
transfer of
Transfer
TransferEverything -> Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$ Text
"wrapBoxed " forall a. Semigroup a => a -> a -> a
<> Text
constructor
Transfer
_ -> Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$ Text
"newBoxed " forall a. Semigroup a => a -> a -> a
<> Text
constructor
suForeignPtr :: Bool -> TypeRep -> Transfer -> CodeGen e Constructor
suForeignPtr :: forall e. Bool -> TypeRep -> Transfer -> CodeGen e Constructor
suForeignPtr Bool
isBoxed TypeRep
hType Transfer
transfer = do
let constructor :: Text
constructor = TypeRep -> Text
typeConName TypeRep
hType
if Bool
isBoxed then
forall e. Text -> Transfer -> CodeGen e Constructor
boxedForeignPtr Text
constructor Transfer
transfer
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
case Transfer
transfer of
Transfer
TransferEverything -> Text
"wrapPtr " forall a. Semigroup a => a -> a -> a
<> Text
constructor
Transfer
_ -> Text
"newPtr " forall a. Semigroup a => a -> a -> a
<> Text
constructor
structForeignPtr :: Struct -> TypeRep -> Transfer -> CodeGen e Constructor
structForeignPtr :: forall e. Struct -> TypeRep -> Transfer -> CodeGen e Constructor
structForeignPtr Struct
s =
forall e. Bool -> TypeRep -> Transfer -> CodeGen e Constructor
suForeignPtr (Struct -> Bool
structIsBoxed Struct
s)
unionForeignPtr :: Union -> TypeRep -> Transfer -> CodeGen e Constructor
unionForeignPtr :: forall e. Union -> TypeRep -> Transfer -> CodeGen e Constructor
unionForeignPtr Union
u =
forall e. Bool -> TypeRep -> Transfer -> CodeGen e Constructor
suForeignPtr (Union -> Bool
unionIsBoxed Union
u)
fObjectToH :: Type -> TypeRep -> Transfer -> ExcCodeGen Constructor
fObjectToH :: Type -> TypeRep -> Transfer -> ExcCodeGen Constructor
fObjectToH Type
t TypeRep
hType Transfer
transfer = do
let constructor :: Text
constructor = TypeRep -> Text
typeConName TypeRep
hType
Bool
isGO <- forall e. Type -> CodeGen e Bool
isGObject Type
t
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
case Transfer
transfer of
Transfer
TransferEverything ->
if Bool
isGO
then Text
"wrapObject " forall a. Semigroup a => a -> a -> a
<> Text
constructor
else Text
"wrapPtr " forall a. Semigroup a => a -> a -> a
<> Text
constructor
Transfer
_ ->
if Bool
isGO
then Text
"newObject " forall a. Semigroup a => a -> a -> a
<> Text
constructor
else Text
"newPtr " forall a. Semigroup a => a -> a -> a
<> Text
constructor
fCallbackToH :: TypeRep -> Transfer -> ExcCodeGen Constructor
fCallbackToH :: TypeRep -> Transfer -> ExcCodeGen Constructor
fCallbackToH TypeRep
hType Transfer
TransferNothing = do
let constructor :: Text
constructor = TypeRep -> Text
typeConName TypeRep
hType
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Constructor
P (Text -> Text
callbackDynamicWrapper Text
constructor))
fCallbackToH TypeRep
_ Transfer
transfer =
forall a. Text -> ExcCodeGen a
notImplementedError (Text
"ForeignCallback with unsupported transfer type `"
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Transfer
transfer forall a. Semigroup a => a -> a -> a
<> Text
"'")
fVariantToH :: Transfer -> CodeGen e Constructor
fVariantToH :: forall e. Transfer -> CodeGen e Constructor
fVariantToH Transfer
transfer =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ case Transfer
transfer of
Transfer
TransferEverything -> Text
"B.GVariant.wrapGVariantPtr"
Transfer
_ -> Text
"B.GVariant.newGVariantFromPtr"
fValueToH :: Transfer -> CodeGen e Constructor
fValueToH :: forall e. Transfer -> CodeGen e Constructor
fValueToH Transfer
transfer =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ case Transfer
transfer of
Transfer
TransferEverything -> Text
"B.GValue.wrapGValuePtr"
Transfer
_ -> Text
"B.GValue.newGValueFromPtr"
fParamSpecToH :: Transfer -> CodeGen e Constructor
fParamSpecToH :: forall e. Transfer -> CodeGen e Constructor
fParamSpecToH Transfer
transfer =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ case Transfer
transfer of
Transfer
TransferEverything -> Text
"B.GParamSpec.wrapGParamSpecPtr"
Transfer
_ -> Text
"B.GParamSpec.newGParamSpecFromPtr"
fClosureToH :: Transfer -> Maybe Type -> CodeGen e Constructor
fClosureToH :: forall e. Transfer -> Maybe Type -> CodeGen e Constructor
fClosureToH Transfer
transfer Maybe Type
Nothing =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ case Transfer
transfer of
Transfer
TransferEverything ->
Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$ Text
"B.GClosure.wrapGClosurePtr . FP.castPtr"
Transfer
_ -> Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$ Text
"B.GClosure.newGClosureFromPtr . FP.castPtr"
fClosureToH Transfer
transfer (Just Type
_) =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ case Transfer
transfer of
Transfer
TransferEverything -> Text
"B.GClosure.wrapGClosurePtr"
Transfer
_ -> Text
"B.GClosure.newGClosureFromPtr"
fToH' :: Type -> Maybe API -> TypeRep -> TypeRep -> Transfer
-> ExcCodeGen Constructor
fToH' :: Type
-> Maybe API
-> TypeRep
-> TypeRep
-> Transfer
-> ExcCodeGen Constructor
fToH' Type
t Maybe API
a TypeRep
hType TypeRep
fType Transfer
transfer
| ( TypeRep
hType forall a. Eq a => a -> a -> Bool
== TypeRep
fType ) = forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
Id
| Just (APIEnum Enumeration
_) <- Maybe API
a = forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(toEnum . fromIntegral)"
| Just (APIFlags Flags
_) <- Maybe API
a = forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"wordToGFlags"
| Type
TError <- Type
t = forall e. Text -> Transfer -> CodeGen e Constructor
boxedForeignPtr Text
"GError" Transfer
transfer
| Type
TVariant <- Type
t = forall e. Transfer -> CodeGen e Constructor
fVariantToH Transfer
transfer
| Type
TGValue <- Type
t = forall e. Transfer -> CodeGen e Constructor
fValueToH Transfer
transfer
| Type
TParamSpec <- Type
t = forall e. Transfer -> CodeGen e Constructor
fParamSpecToH Transfer
transfer
| TGClosure Maybe Type
c <- Type
t = forall e. Transfer -> Maybe Type -> CodeGen e Constructor
fClosureToH Transfer
transfer Maybe Type
c
| Just (APIStruct Struct
s) <- Maybe API
a = forall e. Struct -> TypeRep -> Transfer -> CodeGen e Constructor
structForeignPtr Struct
s TypeRep
hType Transfer
transfer
| Just (APIUnion Union
u) <- Maybe API
a = forall e. Union -> TypeRep -> Transfer -> CodeGen e Constructor
unionForeignPtr Union
u TypeRep
hType Transfer
transfer
| Just (APIObject Object
_) <- Maybe API
a = Type -> TypeRep -> Transfer -> ExcCodeGen Constructor
fObjectToH Type
t TypeRep
hType Transfer
transfer
| Just (APIInterface Interface
_) <- Maybe API
a = Type -> TypeRep -> Transfer -> ExcCodeGen Constructor
fObjectToH Type
t TypeRep
hType Transfer
transfer
| Just (APICallback Callback
_) <- Maybe API
a = TypeRep -> Transfer -> ExcCodeGen Constructor
fCallbackToH TypeRep
hType Transfer
transfer
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TUTF8) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedUTF8CArray"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TFileName) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedFileNameArray"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TUInt8) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedByteString"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TPtr) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedPtrArray"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TBoolean) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(unpackMapZeroTerminatedStorableArray (/= 0))"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TGType) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(unpackMapZeroTerminatedStorableArray GType)"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TFloat) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(unpackMapZeroTerminatedStorableArray realToFrac)"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TDouble) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(unpackMapZeroTerminatedStorableArray realToFrac)"
| TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
_) <- Type
t =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedStorableArray"
| TCArray{} <- Type
t = forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$
Text
"Don't know how to unpack C array of type " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t
| Type
TByteArray <- Type
t = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackGByteArray"
| TGHash Type
_ Type
_ <- Type
t = forall a. Text -> ExcCodeGen a
notImplementedError Text
"Foreign Hashes not supported yet"
| Bool
otherwise = case (TypeRep -> Text
typeShow TypeRep
fType, TypeRep -> Text
typeShow TypeRep
hType) of
(Text
"CString", Text
"T.Text") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"cstringToText"
(Text
"CString", Text
"[Char]") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"cstringToString"
(Text
"CInt", Text
"Char") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(chr . fromIntegral)"
(Text
"CInt", Text
"Bool") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(/= 0)"
(Text
"CFloat", Text
"Float") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"realToFrac"
(Text
"CDouble", Text
"Double") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"realToFrac"
(Text
"CGType", Text
"GType") -> forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"GType"
(Text, Text)
_ ->
forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$ Text
"Don't know how to convert "
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
typeShow TypeRep
fType forall a. Semigroup a => a -> a -> a
<> Text
" into "
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
typeShow TypeRep
hType forall a. Semigroup a => a -> a -> a
<> Text
".\n"
forall a. Semigroup a => a -> a -> a
<> Text
"Internal type: "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t
getHaskellConstructor :: Type -> Transfer -> ExcCodeGen Constructor
getHaskellConstructor :: Type -> Transfer -> ExcCodeGen Constructor
getHaskellConstructor Type
t Transfer
transfer = do
Maybe API
a <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
TypeRep
hType <- forall e. Type -> CodeGen e TypeRep
haskellType Type
t
TypeRep
fType <- forall e. Type -> CodeGen e TypeRep
foreignType Type
t
Type
-> Maybe API
-> TypeRep
-> TypeRep
-> Transfer
-> ExcCodeGen Constructor
fToH' Type
t Maybe API
a TypeRep
hType TypeRep
fType Transfer
transfer
fToH_PackedType :: Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType :: Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t Text
unpacker Transfer
transfer = do
Constructor
innerConstructor <- Type -> Transfer -> ExcCodeGen Constructor
getHaskellConstructor Type
t Transfer
transfer
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
Constructor -> Converter
apply (Text -> Constructor
M Text
unpacker)
Constructor -> Converter
mapC Constructor
innerConstructor
fToH_UnpackGHashTable :: Type -> Type -> Transfer -> ExcCodeGen Converter
fToH_UnpackGHashTable :: Type -> Type -> Transfer -> ExcCodeGen Converter
fToH_UnpackGHashTable Type
keys Type
elems Transfer
transfer = do
Constructor
keysConstructor <- Type -> Transfer -> ExcCodeGen Constructor
getHaskellConstructor Type
keys Transfer
transfer
(Text
_,Text
_,Text
keysUnpack) <- Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers Type
keys
Constructor
elemsConstructor <- Type -> Transfer -> ExcCodeGen Constructor
getHaskellConstructor Type
elems Transfer
transfer
(Text
_,Text
_,Text
elemsUnpack) <- Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers Type
elems
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
Constructor -> Converter
apply (Text -> Constructor
M Text
"unpackGHashTable")
Constructor -> Converter
mapFirst (Text -> Constructor
P Text
keysUnpack)
Constructor -> Converter
mapFirst Constructor
keysConstructor
Constructor -> Converter
mapSecond (Text -> Constructor
P Text
elemsUnpack)
Constructor -> Converter
mapSecond Constructor
elemsConstructor
Constructor -> Converter
apply (Text -> Constructor
P Text
"Map.fromList")
fToH :: Type -> Transfer -> ExcCodeGen Converter
fToH :: Type -> Transfer -> ExcCodeGen Converter
fToH (TGList Type
t) Transfer
transfer = do
Bool
isPtr <- forall e. Type -> CodeGen e Bool
typeIsPtr Type
t
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isPtr) forall a b. (a -> b) -> a -> b
$
forall a. Text -> ExcCodeGen a
badIntroError (Text
"`" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t forall a. Semigroup a => a -> a -> a
<>
Text
"' is not a pointer type, cannot unpack from a GList.")
Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t Text
"unpackGList" Transfer
transfer
fToH (TGSList Type
t) Transfer
transfer = do
Bool
isPtr <- forall e. Type -> CodeGen e Bool
typeIsPtr Type
t
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isPtr) forall a b. (a -> b) -> a -> b
$
forall a. Text -> ExcCodeGen a
badIntroError (Text
"`" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t forall a. Semigroup a => a -> a -> a
<>
Text
"' is not a pointer type, cannot unpack from a GSList.")
Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t Text
"unpackGSList" Transfer
transfer
fToH (TGArray Type
t) Transfer
transfer = Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t Text
"unpackGArray" Transfer
transfer
fToH (TPtrArray Type
t) Transfer
transfer = Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t Text
"unpackGPtrArray" Transfer
transfer
fToH (TGHash Type
a Type
b) Transfer
transfer = Type -> Type -> Transfer -> ExcCodeGen Converter
fToH_UnpackGHashTable Type
a Type
b Transfer
transfer
fToH t :: Type
t@(TCArray Bool
False (-1) (-1) Type
_) Transfer
_ =
forall a. Text -> ExcCodeGen a
badIntroError (Text
"`" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t forall a. Semigroup a => a -> a -> a
<>
Text
"' is an array type, but contains no length information.")
fToH (TCArray Bool
True Int
_ Int
_ t :: Type
t@(TCArray{})) Transfer
transfer =
Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t Text
"unpackZeroTerminatedPtrArray" Transfer
transfer
fToH (TCArray Bool
True Int
_ Int
_ t :: Type
t@(TInterface Name
_)) Transfer
transfer = do
Bool
isScalar <- forall e. Type -> CodeGen e Bool
typeIsEnumOrFlag Type
t
if Bool
isScalar
then Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t Text
"unpackZeroTerminatedStorableArray" Transfer
transfer
else Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t Text
"unpackZeroTerminatedPtrArray" Transfer
transfer
fToH Type
t Transfer
transfer = do
Maybe API
a <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
TypeRep
hType <- forall e. Type -> CodeGen e TypeRep
haskellType Type
t
TypeRep
fType <- forall e. Type -> CodeGen e TypeRep
foreignType Type
t
Constructor
constructor <- Type
-> Maybe API
-> TypeRep
-> TypeRep
-> Transfer
-> ExcCodeGen Constructor
fToH' Type
t Maybe API
a TypeRep
hType TypeRep
fType Transfer
transfer
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply Constructor
constructor
transientToH :: Type -> Transfer -> ExcCodeGen Converter
transientToH :: Type -> Transfer -> ExcCodeGen Converter
transientToH t :: Type
t@(TInterface Name
_) Transfer
TransferNothing = do
Maybe API
a <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
case Maybe API
a of
Just (APIStruct Struct
s) -> if Struct -> Bool
structIsBoxed Struct
s
then forall e. CodeGen e Converter
wrapTransient
else Type -> Transfer -> ExcCodeGen Converter
fToH Type
t Transfer
TransferNothing
Just (APIUnion Union
u) -> if Union -> Bool
unionIsBoxed Union
u
then forall e. CodeGen e Converter
wrapTransient
else Type -> Transfer -> ExcCodeGen Converter
fToH Type
t Transfer
TransferNothing
Maybe API
_ -> Type -> Transfer -> ExcCodeGen Converter
fToH Type
t Transfer
TransferNothing
transientToH Type
t Transfer
transfer = Type -> Transfer -> ExcCodeGen Converter
fToH Type
t Transfer
transfer
wrapTransient :: CodeGen e Converter
wrapTransient :: forall e. CodeGen e Converter
wrapTransient = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Converter
lambdaConvert forall a b. (a -> b) -> a -> b
$ Text
"B.ManagedPtr.withTransient "
unpackCArray :: Text -> Type -> Transfer -> ExcCodeGen Converter
unpackCArray :: Text -> Type -> Transfer -> ExcCodeGen Converter
unpackCArray Text
length (TCArray Bool
False Int
_ Int
_ Type
t) Transfer
transfer =
case Type
t of
TBasicType BasicType
TUTF8 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackUTF8CArrayWithLength " forall a. Semigroup a => a -> a -> a
<> Text
length
TBasicType BasicType
TFileName -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackFileNameArrayWithLength " forall a. Semigroup a => a -> a -> a
<> Text
length
TBasicType BasicType
TUInt8 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackByteStringWithLength " forall a. Semigroup a => a -> a -> a
<> Text
length
TBasicType BasicType
TPtr -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackPtrArrayWithLength " forall a. Semigroup a => a -> a -> a
<> Text
length
TBasicType BasicType
TBoolean -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackMapStorableArrayWithLength (/= 0) " forall a. Semigroup a => a -> a -> a
<> Text
length
TBasicType BasicType
TGType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackMapStorableArrayWithLength GType " forall a. Semigroup a => a -> a -> a
<> Text
length
TBasicType BasicType
TFloat -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackMapStorableArrayWithLength realToFrac " forall a. Semigroup a => a -> a -> a
<> Text
length
TBasicType BasicType
TDouble -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackMapStorableArrayWithLength realToFrac " forall a. Semigroup a => a -> a -> a
<> Text
length
TBasicType BasicType
TUniChar -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackMapStorableArrayWithLength (SP.chr . P.fromIntegral) " forall a. Semigroup a => a -> a -> a
<> Text
length
TBasicType BasicType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"unpackStorableArrayWithLength " forall a. Semigroup a => a -> a -> a
<> Text
length
Type
TGValue -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$
Text
"B.GValue.unpackGValueArrayWithLength " forall a. Semigroup a => a -> a -> a
<> Text
length
TInterface Name
_ -> do
Maybe API
a <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
Bool
isScalar <- forall e. Type -> CodeGen e Bool
typeIsEnumOrFlag Type
t
TypeRep
hType <- forall e. Type -> CodeGen e TypeRep
haskellType Type
t
TypeRep
fType <- forall e. Type -> CodeGen e TypeRep
foreignType Type
t
let (Bool
boxed, Int
size) = case Maybe API
a of
Just (APIStruct Struct
s) -> (Struct -> Bool
structIsBoxed Struct
s, Struct -> Int
structSize Struct
s)
Just (APIUnion Union
u) -> (Union -> Bool
unionIsBoxed Union
u, Union -> Int
unionSize Union
u)
Maybe API
_ -> (Bool
False, Int
0)
let unpacker :: Text
unpacker | Bool
isScalar = Text
"unpackStorableArrayWithLength"
| (Int
size forall a. Eq a => a -> a -> Bool
== Int
0) = Text
"unpackPtrArrayWithLength"
| Bool
boxed = Text
"unpackBoxedArrayWithLength " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
size
| Bool
otherwise = Text
"unpackBlockArrayWithLength " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
size
let transfer' :: Transfer
transfer' | Bool
boxed = if Transfer
transfer forall a. Eq a => a -> a -> Bool
== Transfer
TransferContainer
then Transfer
TransferEverything
else Transfer
transfer
| Bool
otherwise = Transfer
transfer
Constructor
innerConstructor <- Type
-> Maybe API
-> TypeRep
-> TypeRep
-> Transfer
-> ExcCodeGen Constructor
fToH' Type
t Maybe API
a TypeRep
hType TypeRep
fType Transfer
transfer'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
Constructor -> Converter
apply forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$ Text
unpacker forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
length
Constructor -> Converter
mapC Constructor
innerConstructor
Type
_ -> forall a. Text -> ExcCodeGen a
notImplementedError forall a b. (a -> b) -> a -> b
$
Text
"unpackCArray : Don't know how to unpack C Array of type " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Type
t
unpackCArray Text
_ Type
_ Transfer
_ = forall a. Text -> ExcCodeGen a
notImplementedError Text
"unpackCArray : unexpected array type."
data ExposeClosures = WithClosures
| WithoutClosures
deriving (ExposeClosures -> ExposeClosures -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExposeClosures -> ExposeClosures -> Bool
$c/= :: ExposeClosures -> ExposeClosures -> Bool
== :: ExposeClosures -> ExposeClosures -> Bool
$c== :: ExposeClosures -> ExposeClosures -> Bool
Eq)
argumentType :: Type -> ExposeClosures -> CodeGen e (Text, [Text])
argumentType :: forall e. Type -> ExposeClosures -> CodeGen e (Text, [Text])
argumentType (TGList Type
a) ExposeClosures
expose = do
(Text
name, [Text]
constraints) <- forall e. Type -> ExposeClosures -> CodeGen e (Text, [Text])
argumentType Type
a ExposeClosures
expose
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"[" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"]", [Text]
constraints)
argumentType (TGSList Type
a) ExposeClosures
expose = do
(Text
name, [Text]
constraints) <- forall e. Type -> ExposeClosures -> CodeGen e (Text, [Text])
argumentType Type
a ExposeClosures
expose
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"[" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"]", [Text]
constraints)
argumentType Type
t ExposeClosures
expose = do
Maybe API
api <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
Text
s <- TypeRep -> Text
typeShow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e TypeRep
haskellType Type
t
case Maybe API
api of
Just (APIInterface Interface
_) -> do
Text
cls <- forall e. Type -> CodeGen e Text
typeConstraint Type
t
Text
l <- forall e. CodeGen e Text
getFreshTypeVariable
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
l, [Text
cls forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
l])
Just (APIObject Object
_) -> do
Text
cls <- forall e. Type -> CodeGen e Text
typeConstraint Type
t
Text
l <- forall e. CodeGen e Text
getFreshTypeVariable
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
l, [Text
cls forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
l])
Just (APICallback Callback
cb) ->
if Callable -> Bool
callableThrows (Callback -> Callable
cbCallable Callback
cb)
then do
Text
ft <- TypeRep -> Text
typeShow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e TypeRep
foreignType Type
t
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
ft, [])
else
case ExposeClosures
expose of
ExposeClosures
WithClosures -> do
Text
s_withClosures <- TypeRep -> Text
typeShow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e TypeRep
isoHaskellType Type
t
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s_withClosures, [])
ExposeClosures
WithoutClosures ->
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, [])
Maybe API
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, [])
haskellBasicType :: BasicType -> TypeRep
haskellBasicType :: BasicType -> TypeRep
haskellBasicType BasicType
TPtr = TypeRep -> TypeRep
ptr forall a b. (a -> b) -> a -> b
$ Text -> TypeRep
con0 Text
"()"
haskellBasicType BasicType
TBoolean = Text -> TypeRep
con0 Text
"Bool"
haskellBasicType BasicType
TInt = case forall a. Storable a => a -> Int
sizeOf (CInt
0 :: CInt) of
Int
4 -> Text -> TypeRep
con0 Text
"Int32"
Int
n -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Unsupported `gint' length: " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> [Char]
show Int
n)
haskellBasicType BasicType
TUInt = case forall a. Storable a => a -> Int
sizeOf (CUInt
0 :: CUInt) of
Int
4 -> Text -> TypeRep
con0 Text
"Word32"
Int
n -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Unsupported `guint' length: " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> [Char]
show Int
n)
haskellBasicType BasicType
TLong = Text -> TypeRep
con0 Text
"CLong"
haskellBasicType BasicType
TULong = Text -> TypeRep
con0 Text
"CULong"
haskellBasicType BasicType
TInt8 = Text -> TypeRep
con0 Text
"Int8"
haskellBasicType BasicType
TUInt8 = Text -> TypeRep
con0 Text
"Word8"
haskellBasicType BasicType
TInt16 = Text -> TypeRep
con0 Text
"Int16"
haskellBasicType BasicType
TUInt16 = Text -> TypeRep
con0 Text
"Word16"
haskellBasicType BasicType
TInt32 = Text -> TypeRep
con0 Text
"Int32"
haskellBasicType BasicType
TUInt32 = Text -> TypeRep
con0 Text
"Word32"
haskellBasicType BasicType
TInt64 = Text -> TypeRep
con0 Text
"Int64"
haskellBasicType BasicType
TUInt64 = Text -> TypeRep
con0 Text
"Word64"
haskellBasicType BasicType
TGType = Text -> TypeRep
con0 Text
"GType"
haskellBasicType BasicType
TUTF8 = Text -> TypeRep
con0 Text
"T.Text"
haskellBasicType BasicType
TFloat = Text -> TypeRep
con0 Text
"Float"
haskellBasicType BasicType
TDouble = Text -> TypeRep
con0 Text
"Double"
haskellBasicType BasicType
TUniChar = Text -> TypeRep
con0 Text
"Char"
haskellBasicType BasicType
TFileName = Text -> TypeRep
con0 Text
"[Char]"
haskellBasicType BasicType
TIntPtr = Text -> TypeRep
con0 Text
"CIntPtr"
haskellBasicType BasicType
TUIntPtr = Text -> TypeRep
con0 Text
"CUIntPtr"
haskellType :: Type -> CodeGen e TypeRep
haskellType :: forall e. Type -> CodeGen e TypeRep
haskellType (TBasicType BasicType
bt) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BasicType -> TypeRep
haskellBasicType BasicType
bt
haskellType t :: Type
t@(TCArray Bool
False (-1) (-1) (TBasicType BasicType
TUInt8)) =
forall e. Type -> CodeGen e TypeRep
foreignType Type
t
haskellType (TCArray Bool
_ Int
_ Int
_ (TBasicType BasicType
TUInt8)) =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"ByteString" Text -> [TypeRep] -> TypeRep
`con` []
haskellType (TCArray Bool
_ Int
_ Int
_ Type
a) = do
TypeRep
inner <- forall e. Type -> CodeGen e TypeRep
haskellType Type
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TGArray Type
a) = do
TypeRep
inner <- forall e. Type -> CodeGen e TypeRep
haskellType Type
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TPtrArray Type
a) = do
TypeRep
inner <- forall e. Type -> CodeGen e TypeRep
haskellType Type
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (Type
TByteArray) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"ByteString" Text -> [TypeRep] -> TypeRep
`con` []
haskellType (TGList Type
a) = do
TypeRep
inner <- forall e. Type -> CodeGen e TypeRep
haskellType Type
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TGSList Type
a) = do
TypeRep
inner <- forall e. Type -> CodeGen e TypeRep
haskellType Type
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TGHash Type
a Type
b) = do
TypeRep
innerA <- forall e. Type -> CodeGen e TypeRep
haskellType Type
a
TypeRep
innerB <- forall e. Type -> CodeGen e TypeRep
haskellType Type
b
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"Map.Map" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
innerA, TypeRep
innerB]
haskellType Type
TError = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"GError" Text -> [TypeRep] -> TypeRep
`con` []
haskellType Type
TVariant = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"GVariant" Text -> [TypeRep] -> TypeRep
`con` []
haskellType Type
TParamSpec = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"GParamSpec" Text -> [TypeRep] -> TypeRep
`con` []
haskellType (TGClosure (Just inner :: Type
inner@(TInterface Name
n))) = do
API
innerAPI <- forall e. HasCallStack => Type -> CodeGen e API
getAPI Type
inner
case API
innerAPI of
APICallback Callback
_ -> do
let n' :: Name
n' = API -> Name -> Name
normalizedAPIName API
innerAPI Name
n
Text
tname <- forall e. Text -> Name -> CodeGen e Text
qualifiedSymbol (Text -> Text
callbackCType forall a b. (a -> b) -> a -> b
$ Name -> Text
name Name
n') Name
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"GClosure" Text -> [TypeRep] -> TypeRep
`con` [Text -> TypeRep
con0 Text
tname]
API
_ -> forall e. Type -> CodeGen e TypeRep
haskellType (Maybe Type -> Type
TGClosure forall a. Maybe a
Nothing)
haskellType (TGClosure Maybe Type
_) = do
Text
tyvar <- forall e. CodeGen e Text
getFreshTypeVariable
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"GClosure" Text -> [TypeRep] -> TypeRep
`con` [Text -> TypeRep
con0 Text
tyvar]
haskellType Type
TGValue = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"GValue" Text -> [TypeRep] -> TypeRep
`con` []
haskellType t :: Type
t@(TInterface Name
n) = do
API
api <- forall e. HasCallStack => Type -> CodeGen e API
getAPI Type
t
Text
tname <- forall e. API -> Name -> CodeGen e Text
qualifiedAPI API
api Name
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case API
api of
(APIFlags Flags
_) -> Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [Text
tname Text -> [TypeRep] -> TypeRep
`con` []]
API
_ -> Text
tname Text -> [TypeRep] -> TypeRep
`con` []
callableHasClosures :: Callable -> Bool
callableHasClosures :: Callable -> Bool
callableHasClosures = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
/= -Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Arg -> Int
argClosure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Callable -> [Arg]
args
typeIsCallback :: Type -> CodeGen e Bool
typeIsCallback :: forall e. Type -> CodeGen e Bool
typeIsCallback t :: Type
t@(TInterface Name
_) = do
Maybe API
api <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
case Maybe API
api of
Just (APICallback Callback
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe API
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
typeIsCallback Type
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isoHaskellType :: Type -> CodeGen e TypeRep
isoHaskellType :: forall e. Type -> CodeGen e TypeRep
isoHaskellType (TGClosure Maybe Type
Nothing) =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"GClosure" Text -> [TypeRep] -> TypeRep
`con` [Text -> TypeRep
con0 Text
"()"]
isoHaskellType t :: Type
t@(TInterface Name
n) = do
Maybe API
api <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
case Maybe API
api of
Just apiCB :: API
apiCB@(APICallback Callback
cb) -> do
Text
tname <- forall e. API -> Name -> CodeGen e Text
qualifiedAPI API
apiCB Name
n
if Callable -> Bool
callableHasClosures (Callback -> Callable
cbCallable Callback
cb)
then forall (m :: * -> *) a. Monad m => a -> m a
return ((Text -> Text
callbackHTypeWithClosures Text
tname) Text -> [TypeRep] -> TypeRep
`con` [])
else forall (m :: * -> *) a. Monad m => a -> m a
return (Text
tname Text -> [TypeRep] -> TypeRep
`con` [])
Maybe API
_ -> forall e. Type -> CodeGen e TypeRep
haskellType Type
t
isoHaskellType Type
t = forall e. Type -> CodeGen e TypeRep
haskellType Type
t
foreignBasicType :: BasicType -> TypeRep
foreignBasicType :: BasicType -> TypeRep
foreignBasicType BasicType
TBoolean = Text
"CInt" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType BasicType
TUTF8 = Text
"CString" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType BasicType
TFileName = Text
"CString" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType BasicType
TUniChar = Text
"CInt" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType BasicType
TFloat = Text
"CFloat" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType BasicType
TDouble = Text
"CDouble" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType BasicType
TGType = Text
"CGType" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType BasicType
t = BasicType -> TypeRep
haskellBasicType BasicType
t
foreignType :: Type -> CodeGen e TypeRep
foreignType :: forall e. Type -> CodeGen e TypeRep
foreignType (TBasicType BasicType
t) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BasicType -> TypeRep
foreignBasicType BasicType
t
foreignType (TCArray Bool
_ Int
_ Int
_ Type
TGValue) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"B.GValue.GValue" Text -> [TypeRep] -> TypeRep
`con` [])
foreignType (TCArray Bool
zt Int
_ Int
_ Type
t) = do
Maybe API
api <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
let size :: Int
size = case Maybe API
api of
Just (APIStruct Struct
s) -> Struct -> Int
structSize Struct
s
Just (APIUnion Union
u) -> Union -> Int
unionSize Union
u
Maybe API
_ -> Int
0
if Int
size forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bool
zt
then TypeRep -> TypeRep
ptr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e TypeRep
foreignType Type
t
else forall e. Type -> CodeGen e TypeRep
foreignType Type
t
foreignType (TGArray Type
a) = do
TypeRep
inner <- forall e. Type -> CodeGen e TypeRep
foreignType Type
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"GArray" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner])
foreignType (TPtrArray Type
a) = do
TypeRep
inner <- forall e. Type -> CodeGen e TypeRep
foreignType Type
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"GPtrArray" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner])
foreignType (Type
TByteArray) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"GByteArray" Text -> [TypeRep] -> TypeRep
`con` [])
foreignType (TGList Type
a) = do
TypeRep
inner <- forall e. Type -> CodeGen e TypeRep
foreignType Type
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"GList" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner])
foreignType (TGSList Type
a) = do
TypeRep
inner <- forall e. Type -> CodeGen e TypeRep
foreignType Type
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"GSList" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner])
foreignType (TGHash Type
a Type
b) = do
TypeRep
innerA <- forall e. Type -> CodeGen e TypeRep
foreignType Type
a
TypeRep
innerB <- forall e. Type -> CodeGen e TypeRep
foreignType Type
b
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"GHashTable" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
innerA, TypeRep
innerB])
foreignType t :: Type
t@Type
TError = TypeRep -> TypeRep
ptr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e TypeRep
haskellType Type
t
foreignType t :: Type
t@Type
TVariant = TypeRep -> TypeRep
ptr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e TypeRep
haskellType Type
t
foreignType t :: Type
t@Type
TParamSpec = TypeRep -> TypeRep
ptr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e TypeRep
haskellType Type
t
foreignType (TGClosure Maybe Type
Nothing) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"GClosure" Text -> [TypeRep] -> TypeRep
`con` [Text -> TypeRep
con0 Text
"()"])
foreignType t :: Type
t@(TGClosure (Just Type
_)) = TypeRep -> TypeRep
ptr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e TypeRep
haskellType Type
t
foreignType t :: Type
t@(Type
TGValue) = TypeRep -> TypeRep
ptr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e TypeRep
haskellType Type
t
foreignType t :: Type
t@(TInterface Name
n) = do
API
api <- forall e. HasCallStack => Type -> CodeGen e API
getAPI Type
t
let enumIsSigned :: Enumeration -> Bool
enumIsSigned Enumeration
e = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> a -> Bool
< Int64
0) (forall a b. (a -> b) -> [a] -> [b]
map EnumerationMember -> Int64
enumMemberValue (Enumeration -> [EnumerationMember]
enumMembers Enumeration
e))
ctypeForEnum :: Enumeration -> a
ctypeForEnum Enumeration
e = if Enumeration -> Bool
enumIsSigned Enumeration
e
then a
"CInt"
else a
"CUInt"
case API
api of
APIEnum Enumeration
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall {a}. IsString a => Enumeration -> a
ctypeForEnum Enumeration
e) Text -> [TypeRep] -> TypeRep
`con` []
APIFlags (Flags Enumeration
e) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall {a}. IsString a => Enumeration -> a
ctypeForEnum Enumeration
e) Text -> [TypeRep] -> TypeRep
`con` []
APICallback Callback
_ -> do
let n' :: Name
n' = API -> Name -> Name
normalizedAPIName API
api Name
n
Text
tname <- forall e. Text -> Name -> CodeGen e Text
qualifiedSymbol (Text -> Text
callbackCType forall a b. (a -> b) -> a -> b
$ Name -> Text
name Name
n') Name
n
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep -> TypeRep
funptr forall a b. (a -> b) -> a -> b
$ Text
tname Text -> [TypeRep] -> TypeRep
`con` [])
API
_ -> do
Text
tname <- forall e. API -> Name -> CodeGen e Text
qualifiedAPI API
api Name
n
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep -> TypeRep
ptr forall a b. (a -> b) -> a -> b
$ Text
tname Text -> [TypeRep] -> TypeRep
`con` [])
typeIsEnumOrFlag :: Type -> CodeGen e Bool
typeIsEnumOrFlag :: forall e. Type -> CodeGen e Bool
typeIsEnumOrFlag Type
t = do
Maybe API
a <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
case Maybe API
a of
Maybe API
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(Just (APIEnum Enumeration
_)) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
(Just (APIFlags Flags
_)) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe API
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
data TypeAllocInfo = TypeAlloc Text Int
typeAllocInfo :: Type -> CodeGen e (Maybe TypeAllocInfo)
typeAllocInfo :: forall e. Type -> CodeGen e (Maybe TypeAllocInfo)
typeAllocInfo Type
TGValue =
let n :: Int
n = (Int
20)
{-# LINE 974 "lib/Data/GI/CodeGen/Conversions.hsc" #-}
in return $ Just $ TypeAlloc ("SP.callocBytes " <> tshow n) n
typeAllocInfo (TGArray Type
t) = do
Maybe API
api <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
case Maybe API
api of
Just (APIStruct Struct
s) -> case Struct -> Int
structSize Struct
s of
Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Int
n -> let allocator :: Text
allocator = Text
"B.GArray.allocGArray " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Int -> TypeAllocInfo
TypeAlloc Text
allocator Int
n
Maybe API
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
typeAllocInfo Type
t = do
Maybe API
api <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
case Maybe API
api of
Just (APIStruct Struct
s) ->
case Struct -> Int
structSize Struct
s of
Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Int
n -> let allocator :: Text
allocator = if Struct -> Bool
structIsBoxed Struct
s
then Text
"SP.callocBoxedBytes"
else Text
"SP.callocBytes"
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Int -> TypeAllocInfo
TypeAlloc (Text
allocator forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n) Int
n
Maybe API
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
isManaged :: Type -> CodeGen e Bool
isManaged :: forall e. Type -> CodeGen e Bool
isManaged Type
TError = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged Type
TVariant = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged Type
TGValue = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged Type
TParamSpec = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged (TGClosure Maybe Type
_) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged t :: Type
t@(TInterface Name
_) = do
Maybe API
a <- forall e. HasCallStack => Type -> CodeGen e (Maybe API)
findAPI Type
t
case Maybe API
a of
Just (APIObject Object
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just (APIInterface Interface
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just (APIStruct Struct
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just (APIUnion Union
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe API
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isManaged Type
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
typeIsPtr :: Type -> CodeGen e Bool
typeIsPtr :: forall e. Type -> CodeGen e Bool
typeIsPtr Type
t = forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e (Maybe FFIPtrType)
typePtrType Type
t
data FFIPtrType = FFIPtr
| FFIFunPtr
typePtrType :: Type -> CodeGen e (Maybe FFIPtrType)
typePtrType :: forall e. Type -> CodeGen e (Maybe FFIPtrType)
typePtrType (TBasicType BasicType
TPtr) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FFIPtrType
FFIPtr)
typePtrType (TBasicType BasicType
TUTF8) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FFIPtrType
FFIPtr)
typePtrType (TBasicType BasicType
TFileName) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FFIPtrType
FFIPtr)
typePtrType Type
t = do
TypeRep
ft <- forall e. Type -> CodeGen e TypeRep
foreignType Type
t
case TypeRep -> Text
typeConName TypeRep
ft of
Text
"Ptr" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FFIPtrType
FFIPtr)
Text
"FunPtr" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FFIPtrType
FFIFunPtr)
Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
maybeNullConvert :: Type -> CodeGen e (Maybe Text)
maybeNullConvert :: forall e. Type -> CodeGen e (Maybe Text)
maybeNullConvert (TBasicType BasicType
TPtr) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
maybeNullConvert (TGList Type
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
maybeNullConvert (TGSList Type
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
maybeNullConvert Type
t = do
Maybe FFIPtrType
pt <- forall e. Type -> CodeGen e (Maybe FFIPtrType)
typePtrType Type
t
case Maybe FFIPtrType
pt of
Just FFIPtrType
FFIPtr -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Text
"SP.convertIfNonNull")
Just FFIPtrType
FFIFunPtr -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Text
"SP.convertFunPtrIfNonNull")
Maybe FFIPtrType
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
nullPtrForType :: Type -> CodeGen e (Maybe Text)
nullPtrForType :: forall e. Type -> CodeGen e (Maybe Text)
nullPtrForType Type
t = do
Maybe FFIPtrType
pt <- forall e. Type -> CodeGen e (Maybe FFIPtrType)
typePtrType Type
t
case Maybe FFIPtrType
pt of
Just FFIPtrType
FFIPtr -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Text
"FP.nullPtr")
Just FFIPtrType
FFIFunPtr -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Text
"FP.nullFunPtr")
Maybe FFIPtrType
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
typeIsNullable :: Type -> CodeGen e Bool
typeIsNullable :: forall e. Type -> CodeGen e Bool
typeIsNullable Type
t = forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Type -> CodeGen e (Maybe Text)
maybeNullConvert Type
t
elementTypeAndMap :: Type -> Text -> Maybe (Type, Text)
elementTypeAndMap :: Type -> Text -> Maybe (Type, Text)
elementTypeAndMap (TCArray Bool
_ Int
_ Int
_ (TBasicType BasicType
TUInt8)) Text
_ = forall a. Maybe a
Nothing
elementTypeAndMap (TCArray Bool
True Int
_ Int
_ Type
t) Text
_ = forall a. a -> Maybe a
Just (Type
t, Text
"mapZeroTerminatedCArray")
elementTypeAndMap (TCArray Bool
_ Int
_ Int
_ Type
TGValue) Text
len =
forall a. a -> Maybe a
Just (Type
TGValue, Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$ Text
"B.GValue.mapGValueArrayWithLength " forall a. Semigroup a => a -> a -> a
<> Text
len)
elementTypeAndMap (TCArray Bool
False (-1) Int
_ Type
t) Text
len =
forall a. a -> Maybe a
Just (Type
t, Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$ Text
"mapCArrayWithLength " forall a. Semigroup a => a -> a -> a
<> Text
len)
elementTypeAndMap (TCArray Bool
False Int
fixed Int
_ Type
t) Text
_ =
forall a. a -> Maybe a
Just (Type
t, Text -> Text
parenthesize forall a b. (a -> b) -> a -> b
$ Text
"mapCArrayWithLength " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
fixed)
elementTypeAndMap (TGArray Type
t) Text
_ = forall a. a -> Maybe a
Just (Type
t, Text
"mapGArray")
elementTypeAndMap (TPtrArray Type
t) Text
_ = forall a. a -> Maybe a
Just (Type
t, Text
"mapPtrArray")
elementTypeAndMap (TGList Type
t) Text
_ = forall a. a -> Maybe a
Just (Type
t, Text
"mapGList")
elementTypeAndMap (TGSList Type
t) Text
_ = forall a. a -> Maybe a
Just (Type
t, Text
"mapGSList")
elementTypeAndMap Type
_ Text
_ = forall a. Maybe a
Nothing
elementType :: Type -> Maybe Type
elementType :: Type -> Maybe Type
elementType Type
t = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Text -> Maybe (Type, Text)
elementTypeAndMap Type
t forall a. HasCallStack => a
undefined
elementMap :: Type -> Text -> Maybe Text
elementMap :: Type -> Text -> Maybe Text
elementMap Type
t Text
len = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Text -> Maybe (Type, Text)
elementTypeAndMap Type
t Text
len