{-# 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



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

-- | The free monad.
data Free f r = Free (f (Free f r)) | Pure r

instance Functor f => Functor (Free f) where
  fmap :: (a -> b) -> Free f a -> Free f b
fmap a -> b
f = Free f a -> Free f b
forall (f :: * -> *). Functor f => Free f a -> Free f b
go where
    go :: Free f a -> Free f b
go (Pure a
a)  = b -> Free f b
forall (f :: * -> *) r. r -> Free f r
Pure (a -> b
f a
a)
    go (Free f (Free f a)
fa) = f (Free f b) -> Free f b
forall (f :: * -> *) r. f (Free f r) -> Free f r
Free (Free f a -> Free f b
go (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
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 :: a -> Free f a
pure = a -> Free f a
forall (f :: * -> *) r. r -> Free f r
Pure
    Pure a -> b
a <*> :: Free f (a -> b) -> Free f a -> Free f b
<*> Pure a
b = b -> Free f b
forall (f :: * -> *) r. r -> Free f r
Pure (b -> Free f b) -> b -> Free f b
forall a b. (a -> b) -> a -> b
$ a -> b
a a
b
    Pure a -> b
a <*> Free f (Free f a)
mb = f (Free f b) -> Free f b
forall (f :: * -> *) r. f (Free f r) -> Free f r
Free (f (Free f b) -> Free f b) -> f (Free f b) -> Free f b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Free f a -> Free f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
a (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
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 = f (Free f b) -> Free f b
forall (f :: * -> *) r. f (Free f r) -> Free f r
Free (f (Free f b) -> Free f b) -> f (Free f b) -> Free f b
forall a b. (a -> b) -> a -> b
$ (Free f (a -> b) -> Free f a -> Free f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Free f a
b) (Free f (a -> b) -> Free f b)
-> f (Free f (a -> b)) -> f (Free f 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
    return :: a -> Free f a
return = a -> Free f a
forall (f :: * -> *) r. r -> Free f r
Pure
    (Free f (Free f a)
x) >>= :: Free f a -> (a -> Free f b) -> Free f b
>>= a -> Free f b
f = f (Free f b) -> Free f b
forall (f :: * -> *) r. f (Free f r) -> Free f r
Free ((Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Free f a -> (a -> Free f b) -> Free f b
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

-- | Lift some command to the Free monad.
liftF :: (Functor f) => f r -> Free f r
liftF :: f r -> Free f r
liftF f r
command = f (Free f r) -> Free f r
forall (f :: * -> *) r. f (Free f r) -> Free f r
Free ((r -> Free f r) -> f r -> f (Free f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Free f r
forall (f :: * -> *) r. r -> Free f r
Pure f r
command)

-- String identifying a constructor in the generated code, which is
-- either (by default) a pure function (indicated by the P
-- constructor) or a function returning values on a monad (M
-- constructor). 'Id' denotes the identity function.
data Constructor = P Text | M Text | Id
                   deriving (Constructor -> Constructor -> Bool
(Constructor -> Constructor -> Bool)
-> (Constructor -> Constructor -> Bool) -> Eq Constructor
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 -> String
(Int -> Constructor -> ShowS)
-> (Constructor -> String)
-> ([Constructor] -> ShowS)
-> Show Constructor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constructor] -> ShowS
$cshowList :: [Constructor] -> ShowS
show :: Constructor -> String
$cshow :: Constructor -> String
showsPrec :: Int -> Constructor -> ShowS
$cshowsPrec :: Int -> Constructor -> ShowS
Show)
instance IsString Constructor where
    fromString :: String -> Constructor
fromString = Text -> Constructor
P (Text -> Constructor) -> (String -> Text) -> String -> Constructor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

data FExpr next = Apply Constructor next
                | LambdaConvert Text next
                | MapC Map Constructor next
                | Literal Constructor next
                  deriving (Int -> FExpr next -> ShowS
[FExpr next] -> ShowS
FExpr next -> String
(Int -> FExpr next -> ShowS)
-> (FExpr next -> String)
-> ([FExpr next] -> ShowS)
-> Show (FExpr next)
forall next. Show next => Int -> FExpr next -> ShowS
forall next. Show next => [FExpr next] -> ShowS
forall next. Show next => FExpr next -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FExpr next] -> ShowS
$cshowList :: forall next. Show next => [FExpr next] -> ShowS
show :: FExpr next -> String
$cshow :: forall next. Show next => FExpr next -> String
showsPrec :: Int -> FExpr next -> ShowS
$cshowsPrec :: forall next. Show next => Int -> FExpr next -> ShowS
Show, a -> FExpr b -> FExpr a
(a -> b) -> FExpr a -> FExpr b
(forall a b. (a -> b) -> FExpr a -> FExpr b)
-> (forall a b. a -> FExpr b -> FExpr a) -> Functor FExpr
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
<$ :: a -> FExpr b -> FExpr a
$c<$ :: forall a b. a -> FExpr b -> FExpr a
fmap :: (a -> b) -> FExpr a -> FExpr b
$cfmap :: forall a b. (a -> b) -> FExpr a -> FExpr b
Functor)

type Converter = Free FExpr ()

-- Different available maps.
data Map = Map | MapFirst | MapSecond
         deriving (Int -> Map -> ShowS
[Map] -> ShowS
Map -> String
(Int -> Map -> ShowS)
-> (Map -> String) -> ([Map] -> ShowS) -> Show Map
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Map] -> ShowS
$cshowList :: [Map] -> ShowS
show :: Map -> String
$cshow :: Map -> String
showsPrec :: Int -> Map -> ShowS
$cshowsPrec :: Int -> Map -> ShowS
Show)

-- Naming for the maps.
mapName :: Map -> Text
mapName :: Map -> Text
mapName Map
Map = Text
"map"
mapName Map
MapFirst = Text
"mapFirst"
mapName Map
MapSecond = Text
"mapSecond"

-- Naming for the monadic versions of the maps that we use
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 = FExpr () -> Converter
forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF (FExpr () -> Converter) -> FExpr () -> Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> () -> FExpr ()
forall next. Constructor -> next -> FExpr next
Apply Constructor
f ()

mapC :: Constructor -> Converter
mapC :: Constructor -> Converter
mapC Constructor
f = FExpr () -> Converter
forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF (FExpr () -> Converter) -> FExpr () -> Converter
forall a b. (a -> b) -> a -> b
$ Map -> Constructor -> () -> FExpr ()
forall next. Map -> Constructor -> next -> FExpr next
MapC Map
Map Constructor
f ()

mapFirst :: Constructor -> Converter
mapFirst :: Constructor -> Converter
mapFirst Constructor
f = FExpr () -> Converter
forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF (FExpr () -> Converter) -> FExpr () -> Converter
forall a b. (a -> b) -> a -> b
$ Map -> Constructor -> () -> FExpr ()
forall next. Map -> Constructor -> next -> FExpr next
MapC Map
MapFirst Constructor
f ()

mapSecond :: Constructor -> Converter
mapSecond :: Constructor -> Converter
mapSecond Constructor
f = FExpr () -> Converter
forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF (FExpr () -> Converter) -> FExpr () -> Converter
forall a b. (a -> b) -> a -> b
$ Map -> Constructor -> () -> FExpr ()
forall next. Map -> Constructor -> next -> FExpr next
MapC Map
MapSecond Constructor
f ()

literal :: Constructor -> Converter
literal :: Constructor -> Converter
literal Constructor
f = FExpr () -> Converter
forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF (FExpr () -> Converter) -> FExpr () -> Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> () -> FExpr ()
forall next. Constructor -> next -> FExpr next
Literal Constructor
f ()

lambdaConvert :: Text -> Converter
lambdaConvert :: Text -> Converter
lambdaConvert Text
c = FExpr () -> Converter
forall (f :: * -> *) r. Functor f => f r -> Free f r
liftF (FExpr () -> Converter) -> FExpr () -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> () -> FExpr ()
forall next. Text -> next -> FExpr next
LambdaConvert Text
c ()

genConversion :: Text -> Converter -> CodeGen Text
genConversion :: Text -> Converter -> CodeGen Text
genConversion Text
l (Pure ()) = Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
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 Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"let " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next
    Apply (M Text
f) Converter
next ->
        do Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" <- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next
    Apply Constructor
Id Converter
next -> Text -> Converter -> CodeGen Text
genConversion Text
l Converter
next

    MapC Map
m (P Text
f) Converter
next ->
        do Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"let " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Map -> Text
mapName Map
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next
    MapC Map
m (M Text
f) Converter
next ->
        do Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" <- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Map -> Text
monadicMapName Map
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next
    MapC Map
_ Constructor
Id Converter
next -> Text -> Converter -> CodeGen Text
genConversion Text
l Converter
next

    LambdaConvert Text
conv Converter
next ->
        do Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
conv Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" $ \\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> do"
           BaseCodeGen e ()
CodeGen ()
increaseIndent
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next

    Literal (P Text
f) Converter
next ->
        do Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"let " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f
           Text -> Converter -> CodeGen Text
genConversion Text
l Converter
next
    Literal (M Text
f) Converter
next ->
        do Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" <- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f
           Text -> Converter -> CodeGen Text
genConversion Text
l Converter
next
    Literal Constructor
Id Converter
next -> Text -> Converter -> CodeGen Text
genConversion Text
l Converter
next

-- | Given an array, together with its type, return the code for reading
-- its length.
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
  Text -> ExcCodeGen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExcCodeGen Text) -> Text -> ExcCodeGen Text
forall a b. (a -> b) -> a -> b
$ Text
"fromIntegral $ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reader Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
array
    where findReader :: ExcCodeGen Text
findReader = case Type
t of
                     TBasicType BasicType
TUInt8 -> Text -> ExcCodeGen Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"B.length"
                     Type
_ -> Text -> ExcCodeGen Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"P.length"
computeArrayLength Text
_ Type
t =
    Text -> ExcCodeGen Text
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Text) -> Text -> ExcCodeGen Text
forall a b. (a -> b) -> a -> b
$ Text
"computeArrayLength called on non-CArray type "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t

convert :: Text -> BaseCodeGen e Converter -> BaseCodeGen e Text
convert :: Text -> BaseCodeGen e Converter -> BaseCodeGen e Text
convert Text
l BaseCodeGen e Converter
c = do
  Converter
c' <- BaseCodeGen e Converter
c
  Text -> Converter -> CodeGen Text
genConversion Text
l Converter
c'

hObjectToF :: Type -> Transfer -> ExcCodeGen Constructor
hObjectToF :: Type -> Transfer -> ExcCodeGen Constructor
hObjectToF Type
t Transfer
transfer =
  if Transfer
transfer Transfer -> Transfer -> Bool
forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
  then do
    Bool
isGO <- Type -> CodeGen Bool
isGObject Type
t
    if Bool
isGO
    then Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.ManagedPtr.disownObject"
    else Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.ManagedPtr.disownManagedPtr"
  -- castPtr since we accept any instance of the class associated with
  -- the GObject, not just the precise type of the GObject, while the
  -- foreign function declaration requires a pointer of the precise
  -- type.
  else Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrCastPtr"

hVariantToF :: Transfer -> CodeGen Constructor
hVariantToF :: Transfer -> CodeGen Constructor
hVariantToF Transfer
transfer =
  if Transfer
transfer Transfer -> Transfer -> Bool
forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
  then Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GVariant.disownGVariant"
  else Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"

hValueToF :: Transfer -> CodeGen Constructor
hValueToF :: Transfer -> CodeGen Constructor
hValueToF Transfer
transfer =
  if Transfer
transfer Transfer -> Transfer -> Bool
forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
  then Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GValue.disownGValue"
  else Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"

hParamSpecToF :: Transfer -> CodeGen Constructor
hParamSpecToF :: Transfer -> CodeGen Constructor
hParamSpecToF Transfer
transfer =
  if Transfer
transfer Transfer -> Transfer -> Bool
forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
  then Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GParamSpec.disownGParamSpec"
  else Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"

hClosureToF :: Transfer -> Maybe Type -> CodeGen Constructor
-- Untyped closures
hClosureToF :: Transfer -> Maybe Type -> CodeGen Constructor
hClosureToF Transfer
transfer Maybe Type
Nothing =
  if Transfer
transfer Transfer -> Transfer -> Bool
forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
  then Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GClosure.disownGClosure"
  -- We cast the point here because the foreign type for untyped
  -- closures is always represented as Ptr (GClosure ()), while the
  -- corresponding Haskell type is the parametric "GClosure a".
  else Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrCastPtr"
-- Typed closures
hClosureToF Transfer
transfer (Just Type
_) =
  if Transfer
transfer Transfer -> Transfer -> Bool
forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
  then Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GClosure.disownGClosure"
  else Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"

hBoxedToF :: Transfer -> CodeGen Constructor
hBoxedToF :: Transfer -> CodeGen Constructor
hBoxedToF Transfer
transfer =
  if Transfer
transfer Transfer -> Transfer -> Bool
forall a. Eq a => a -> a -> Bool
== Transfer
TransferEverything
  then Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.ManagedPtr.disownBoxed"
  else Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
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 Transfer -> Transfer -> Bool
forall a. Eq a => a -> a -> Bool
/= Transfer
TransferEverything Bool -> Bool -> Bool
|| Struct -> Bool
structIsBoxed Struct
s then
        Transfer -> CodeGen Constructor
hBoxedToF Transfer
transfer
    else do
        Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Struct -> Int
structSize Struct
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (ReaderT
   CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ())
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a b. (a -> b) -> a -> b
$
             Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a. Text -> ExcCodeGen a
badIntroError Text
"Transferring a non-boxed struct with unknown size!"
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
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 Transfer -> Transfer -> Bool
forall a. Eq a => a -> a -> Bool
/= Transfer
TransferEverything Bool -> Bool -> Bool
|| Union -> Bool
unionIsBoxed Union
u then
        Transfer -> CodeGen Constructor
hBoxedToF Transfer
transfer
    else do
        Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Union -> Int
unionSize Union
u Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (ReaderT
   CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ())
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a b. (a -> b) -> a -> b
$
             Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a. Text -> ExcCodeGen a
badIntroError Text
"Transferring a non-boxed union with unknown size!"
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unsafeManagedPtrGetPtr"

-- Given the Haskell and Foreign types, returns the name of the
-- function marshalling between both.
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 TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
fType ) = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
Id
    | Type
TError <- Type
t = Transfer -> CodeGen Constructor
hBoxedToF Transfer
transfer
    | Type
TVariant <- Type
t = Transfer -> CodeGen Constructor
hVariantToF Transfer
transfer
    | Type
TGValue <- Type
t = Transfer -> CodeGen Constructor
hValueToF Transfer
transfer
    | Type
TParamSpec <- Type
t = Transfer -> CodeGen Constructor
hParamSpecToF Transfer
transfer
    | TGClosure Maybe Type
c <- Type
t = Transfer -> Maybe Type -> CodeGen Constructor
hClosureToF Transfer
transfer Maybe Type
c
    | Just (APIEnum Enumeration
_) <- Maybe API
a = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(fromIntegral . fromEnum)"
    | Just (APIFlags Flags
_) <- Maybe API
a = Constructor -> ExcCodeGen Constructor
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
    -- Converting callback types requires more context, we leave that
    -- as a special case to be implemented by the caller.
    | Just (APICallback Callback
_) <- Maybe API
a = String -> ExcCodeGen Constructor
forall a. HasCallStack => String -> a
error String
"Cannot handle callback type here!! "
    | Type
TByteArray <- Type
t = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packGByteArray"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TUTF8) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedUTF8CArray"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TFileName) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedFileNameArray"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TPtr) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedPtrArray"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TUInt8) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedByteString"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TBoolean) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapZeroTerminatedStorableArray (fromIntegral . fromEnum))"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TGType) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapZeroTerminatedStorableArray gtypeToCGtype)"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
_) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packZeroTerminatedStorableArray"
    | TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TUTF8) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packUTF8CArray"
    | TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TFileName) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packFileNameArray"
    | TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TPtr) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packPtrArray"
    | TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TUInt8) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packByteString"
    | TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TBoolean) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapStorableArray (fromIntegral . fromEnum))"
    | TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TGType) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapStorableArray gtypeToCGType)"
    | TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TFloat) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapStorableArray realToFrac)"
    | TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
TDouble) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(packMapStorableArray realToFrac)"
    | TCArray Bool
False Int
_ Int
_ (TBasicType BasicType
_) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"packStorableArray"
    | TCArray Bool
False Int
_ Int
_ Type
TGValue <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"B.GValue.packGValueArray"
    | TCArray{}  <- Type
t = Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Constructor) -> Text -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$
                   Text
"Don't know how to pack C array of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
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") -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"textToCString"
               (Text
"[Char]", Text
"CString") -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"stringToCString"
               (Text
"Char", Text
"CInt")      -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(fromIntegral . ord)"
               (Text
"Bool", Text
"CInt")      -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(fromIntegral . fromEnum)"
               (Text
"Float", Text
"CFloat")   -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"realToFrac"
               (Text
"Double", Text
"CDouble") -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"realToFrac"
               (Text
"GType", Text
"CGType")   -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"gtypeToCGType"
               (Text, Text)
_                     -> Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Constructor) -> Text -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$
                                        Text
"Don't know how to convert "
                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
typeShow TypeRep
hType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" into "
                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
typeShow TypeRep
fType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".\n"
                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Internal type: "
                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
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 <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  TypeRep
hType <- Type -> CodeGen TypeRep
haskellType Type
t
  TypeRep
fType <- Type -> CodeGen 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
  Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ do
    Constructor -> Converter
mapC Constructor
innerConstructor
    Constructor -> Converter
apply (Text -> Constructor
M Text
packer)

-- | Try to find the `hash` and `equal` functions appropriate for the
-- given type, when used as a key in a GHashTable.
hashTableKeyMappings :: Type -> ExcCodeGen (Text, Text)
hashTableKeyMappings :: Type -> ExcCodeGen (Text, Text)
hashTableKeyMappings (TBasicType BasicType
TPtr) = (Text, Text) -> ExcCodeGen (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"gDirectHash", Text
"gDirectEqual")
hashTableKeyMappings (TBasicType BasicType
TUTF8) = (Text, Text) -> ExcCodeGen (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"gStrHash", Text
"gStrEqual")
hashTableKeyMappings Type
t =
    Text -> ExcCodeGen (Text, Text)
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen (Text, Text))
-> Text -> ExcCodeGen (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text
"GHashTable key of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" unsupported."

-- | `GHashTable` tries to fit every type into a pointer, the
-- following function tries to find the appropriate
-- (destroy,packer,unpacker) for the given type.
hashTablePtrPackers :: Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers :: Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers (TBasicType BasicType
TPtr) =
    (Text, Text, Text) -> ExcCodeGen (Text, Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"Nothing", Text
"ptrPackPtr", Text
"ptrUnpackPtr")
hashTablePtrPackers (TBasicType BasicType
TUTF8) =
    (Text, Text, Text) -> ExcCodeGen (Text, Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"(Just ptr_to_g_free)", Text
"cstringPackPtr", Text
"cstringUnpackPtr")
hashTablePtrPackers Type
t =
    Text -> ExcCodeGen (Text, Text, Text)
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen (Text, Text, Text))
-> Text -> ExcCodeGen (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ Text
"GHashTable element of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t Text -> Text -> Text
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
  -- We will be adding elements to the Hash list with appropriate
  -- destructors, so we always want a fresh copy.
  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
  Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
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 <- Type -> CodeGen Bool
typeIsPtr Type
t
  Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isPtr) (ReaderT
   CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ())
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a b. (a -> b) -> a -> b
$
       Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a. Text -> ExcCodeGen a
badIntroError (Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t Text -> Text -> Text
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 <- Type -> CodeGen Bool
typeIsPtr Type
t
  Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isPtr) (ReaderT
   CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ())
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a b. (a -> b) -> a -> b
$
       Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a. Text -> ExcCodeGen a
badIntroError (Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t Text -> Text -> Text
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 Text -> Text -> Text
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 <- Type -> CodeGen 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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"StorableArray") Transfer
transfer
  else do
    Maybe API
api <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (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 Int -> Int -> Bool
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"PtrArray") Transfer
transfer
    else Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t (Text
packer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"BlockArray " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
size) Transfer
transfer

hToF Type
t Transfer
transfer = do
  Maybe API
a <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  TypeRep
hType <- Type -> CodeGen TypeRep
haskellType Type
t
  TypeRep
fType <- Type -> CodeGen 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
  Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply Constructor
constructor

boxedForeignPtr :: Text -> Transfer -> CodeGen Constructor
boxedForeignPtr :: Text -> Transfer -> CodeGen Constructor
boxedForeignPtr Text
constructor Transfer
transfer = Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$
   case Transfer
transfer of
     Transfer
TransferEverything -> Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"wrapBoxed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
     Transfer
_ -> Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"newBoxed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor

suForeignPtr :: Bool -> TypeRep -> Transfer -> CodeGen Constructor
suForeignPtr :: Bool -> TypeRep -> Transfer -> CodeGen Constructor
suForeignPtr Bool
isBoxed TypeRep
hType Transfer
transfer = do
  let constructor :: Text
constructor = TypeRep -> Text
typeConName TypeRep
hType
  if Bool
isBoxed then
      Text -> Transfer -> CodeGen Constructor
boxedForeignPtr Text
constructor Transfer
transfer
  else Constructor -> BaseCodeGen e Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> BaseCodeGen e Constructor)
-> Constructor -> BaseCodeGen e Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
       case Transfer
transfer of
         Transfer
TransferEverything -> Text
"wrapPtr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
         Transfer
_ -> Text
"newPtr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor

structForeignPtr :: Struct -> TypeRep -> Transfer -> CodeGen Constructor
structForeignPtr :: Struct -> TypeRep -> Transfer -> CodeGen Constructor
structForeignPtr Struct
s =
    Bool -> TypeRep -> Transfer -> CodeGen Constructor
suForeignPtr (Struct -> Bool
structIsBoxed Struct
s)

unionForeignPtr :: Union -> TypeRep -> Transfer -> CodeGen Constructor
unionForeignPtr :: Union -> TypeRep -> Transfer -> CodeGen Constructor
unionForeignPtr Union
u =
    Bool -> TypeRep -> Transfer -> CodeGen 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 <- Type -> CodeGen Bool
isGObject Type
t
  Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
    case Transfer
transfer of
    Transfer
TransferEverything ->
        if Bool
isGO
        then Text
"wrapObject " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
        else Text
"wrapPtr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
    Transfer
_ ->
        if Bool
isGO
        then Text
"newObject " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
        else Text
"newPtr " Text -> Text -> Text
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
  Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Constructor
P (Text -> Text
callbackDynamicWrapper Text
constructor))
fCallbackToH TypeRep
_ Transfer
transfer =
  Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
notImplementedError (Text
"ForeignCallback with unsupported transfer type `"
                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Transfer -> Text
forall a. Show a => a -> Text
tshow Transfer
transfer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")

fVariantToH :: Transfer -> CodeGen Constructor
fVariantToH :: Transfer -> CodeGen Constructor
fVariantToH Transfer
transfer =
  Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
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 Constructor
fValueToH :: Transfer -> CodeGen Constructor
fValueToH Transfer
transfer =
  Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
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 Constructor
fParamSpecToH :: Transfer -> CodeGen Constructor
fParamSpecToH Transfer
transfer =
  Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
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 Constructor
-- Untyped closures
fClosureToH :: Transfer -> Maybe Type -> CodeGen Constructor
fClosureToH Transfer
transfer Maybe Type
Nothing =
  Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ case Transfer
transfer of
                  Transfer
TransferEverything ->
                    Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"B.GClosure.wrapGClosurePtr . FP.castPtr"
                  Transfer
_ -> Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"B.GClosure.newGClosureFromPtr . FP.castPtr"
-- Typed closures
fClosureToH Transfer
transfer (Just Type
_) =
  Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      Constructor)
-> Constructor
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
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 TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
fType ) = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
Id
    | Just (APIEnum Enumeration
_) <- Maybe API
a = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(toEnum . fromIntegral)"
    | Just (APIFlags Flags
_) <- Maybe API
a = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"wordToGFlags"
    | Type
TError <- Type
t = Text -> Transfer -> CodeGen Constructor
boxedForeignPtr Text
"GError" Transfer
transfer
    | Type
TVariant <- Type
t = Transfer -> CodeGen Constructor
fVariantToH Transfer
transfer
    | Type
TGValue <- Type
t = Transfer -> CodeGen Constructor
fValueToH Transfer
transfer
    | Type
TParamSpec <- Type
t = Transfer -> CodeGen Constructor
fParamSpecToH Transfer
transfer
    | TGClosure Maybe Type
c <- Type
t = Transfer -> Maybe Type -> CodeGen Constructor
fClosureToH Transfer
transfer Maybe Type
c
    | Just (APIStruct Struct
s) <- Maybe API
a = Struct -> TypeRep -> Transfer -> CodeGen Constructor
structForeignPtr Struct
s TypeRep
hType Transfer
transfer
    | Just (APIUnion Union
u) <- Maybe API
a = Union -> TypeRep -> Transfer -> CodeGen 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 =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedUTF8CArray"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TFileName) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedFileNameArray"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TUInt8) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedByteString"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TPtr) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedPtrArray"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TBoolean) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(unpackMapZeroTerminatedStorableArray (/= 0))"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TGType) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(unpackMapZeroTerminatedStorableArray GType)"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TFloat) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(unpackMapZeroTerminatedStorableArray realToFrac)"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
TDouble) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"(unpackMapZeroTerminatedStorableArray realToFrac)"
    | TCArray Bool
True Int
_ Int
_ (TBasicType BasicType
_) <- Type
t =
        Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackZeroTerminatedStorableArray"
    | TCArray{}  <- Type
t = Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Constructor) -> Text -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$
                   Text
"Don't know how to unpack C array of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t
    | Type
TByteArray <- Type
t = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"unpackGByteArray"
    | TGHash Type
_ Type
_ <- Type
t = Text -> ExcCodeGen Constructor
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") -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"cstringToText"
               (Text
"CString", Text
"[Char]") -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return (Constructor -> ExcCodeGen Constructor)
-> Constructor -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M Text
"cstringToString"
               (Text
"CInt", Text
"Char")      -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(chr . fromIntegral)"
               (Text
"CInt", Text
"Bool")      -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"(/= 0)"
               (Text
"CFloat", Text
"Float")   -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"realToFrac"
               (Text
"CDouble", Text
"Double") -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"realToFrac"
               (Text
"CGType", Text
"GType")   -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return Constructor
"GType"
               (Text, Text)
_                     ->
                   Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Constructor) -> Text -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ Text
"Don't know how to convert "
                                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
typeShow TypeRep
fType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" into "
                                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
typeShow TypeRep
hType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".\n"
                                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Internal type: "
                                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
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 <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  TypeRep
hType <- Type -> CodeGen TypeRep
haskellType Type
t
  TypeRep
fType <- Type -> CodeGen 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
  Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
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
  Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
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 <- Type -> CodeGen Bool
typeIsPtr Type
t
  Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isPtr) (ReaderT
   CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ())
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a b. (a -> b) -> a -> b
$
       Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a. Text -> ExcCodeGen a
badIntroError (Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t Text -> Text -> Text
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 <- Type -> CodeGen Bool
typeIsPtr Type
t
  Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isPtr) (ReaderT
   CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ())
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a b. (a -> b) -> a -> b
$
       Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) ()
forall a. Text -> ExcCodeGen a
badIntroError (Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t Text -> Text -> Text
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
-- We cannot unpack arrays without any kind of length info.
fToH t :: Type
t@(TCArray Bool
False (-1) (-1) Type
_) Transfer
_ =
  Text -> ExcCodeGen Converter
forall a. Text -> ExcCodeGen a
badIntroError (Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t Text -> Text -> Text
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 <- Type -> CodeGen 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 <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  TypeRep
hType <- Type -> CodeGen TypeRep
haskellType Type
t
  TypeRep
fType <- Type -> CodeGen 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
  Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply Constructor
constructor

-- | Somewhat like `fToH`, but with slightly different borrowing
-- semantics: in the case of `TransferNothing` we wrap incoming
-- pointers to boxed structs into transient `ManagedPtr`s (every other
-- case behaves as `fToH`). These are `ManagedPtr`s for which we do
-- not make a copy, and which will be disowned when the function
-- exists, instead of making a copy that the GC will collect
-- eventually.
--
-- This is necessary in order to get the semantics of callbacks and
-- signals right: in some cases making a copy of the object does not
-- simply increase the refcount, but rather makes a full copy. In this
-- cases modification of the original object is not possible, but this
-- is sometimes useful, see for example
--
-- https://github.com/haskell-gi/haskell-gi/issues/97
--
-- Another situation where making a copy of incoming arguments is
-- problematic is when the underlying library is not thread-safe. When
-- running under the threaded GHC runtime it can happen that the GC
-- runs on a different OS thread than the thread where the object was
-- created, and this leads to rather mysterious bugs, see for example
--
-- https://github.com/haskell-gi/haskell-gi/issues/96
--
-- This case is particularly nasty, since it affects `onWidgetDraw`,
-- which is very common.
transientToH :: Type -> Transfer -> ExcCodeGen Converter
transientToH :: Type -> Transfer -> ExcCodeGen Converter
transientToH t :: Type
t@(TInterface Name
_) Transfer
TransferNothing = do
  Maybe API
a <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
a of
    Just (APIStruct Struct
s) -> if Struct -> Bool
structIsBoxed Struct
s
                          then Type -> CodeGen Converter
wrapTransient Type
t
                          else Type -> Transfer -> ExcCodeGen Converter
fToH Type
t Transfer
TransferNothing
    Just (APIUnion Union
u) -> if Union -> Bool
unionIsBoxed Union
u
                         then Type -> CodeGen Converter
wrapTransient Type
t
                         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

-- | Wrap the given transient.
wrapTransient :: Type -> CodeGen Converter
wrapTransient :: Type -> CodeGen Converter
wrapTransient Type
t = do
  Text
hCon <- TypeRep -> Text
typeConName (TypeRep -> Text)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
haskellType Type
t
  Converter -> BaseCodeGen e Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> BaseCodeGen e Converter)
-> Converter -> BaseCodeGen e Converter
forall a b. (a -> b) -> a -> b
$ Text -> Converter
lambdaConvert (Text -> Converter) -> Text -> Converter
forall a b. (a -> b) -> a -> b
$ Text
"B.ManagedPtr.withTransient " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hCon

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 -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                        Text
"unpackUTF8CArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType BasicType
TFileName -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                            Text
"unpackFileNameArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType BasicType
TUInt8 -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                         Text
"unpackByteStringWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType BasicType
TPtr -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                         Text
"unpackPtrArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType BasicType
TBoolean -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                         Text
"unpackMapStorableArrayWithLength (/= 0) " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType BasicType
TGType -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                         Text
"unpackMapStorableArrayWithLength GType " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType BasicType
TFloat -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                         Text
"unpackMapStorableArrayWithLength realToFrac " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType BasicType
TDouble -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                         Text
"unpackMapStorableArrayWithLength realToFrac " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType BasicType
_ -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                         Text
"unpackStorableArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    Type
TGValue -> Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
               Text
"B.GValue.unpackGValueArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TInterface Name
_ -> do
           Maybe API
a <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
           Bool
isScalar <- Type -> CodeGen Bool
typeIsEnumOrFlag Type
t
           TypeRep
hType <- Type -> CodeGen TypeRep
haskellType Type
t
           TypeRep
fType <- Type -> CodeGen 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) = Text
"unpackPtrArrayWithLength"
                        | Bool
boxed       = Text
"unpackBoxedArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
size
                        | Bool
otherwise   = Text
"unpackBlockArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
size
               -- We always make a copy of the elements when unpacking
               -- boxed types.
           let transfer' :: Transfer
transfer' | Bool
boxed      = if Transfer
transfer Transfer -> Transfer -> Bool
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'
           Converter -> ExcCodeGen Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter -> ExcCodeGen Converter)
-> Converter -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$ do
             Constructor -> Converter
apply (Constructor -> Converter) -> Constructor -> Converter
forall a b. (a -> b) -> a -> b
$ Text -> Constructor
M (Text -> Constructor) -> Text -> Constructor
forall a b. (a -> b) -> a -> b
$ Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
unpacker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
             Constructor -> Converter
mapC Constructor
innerConstructor
    Type
_ -> Text -> ExcCodeGen Converter
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Converter) -> Text -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$
         Text
"unpackCArray : Don't know how to unpack C Array of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t

unpackCArray Text
_ Type
_ Transfer
_ = Text -> ExcCodeGen Converter
forall a. Text -> ExcCodeGen a
notImplementedError Text
"unpackCArray : unexpected array type."

-- | Whether to expose closures and the associated destroy notify
-- handlers in the Haskell wrapper.
data ExposeClosures = WithClosures
                    | WithoutClosures
  deriving (ExposeClosures -> ExposeClosures -> Bool
(ExposeClosures -> ExposeClosures -> Bool)
-> (ExposeClosures -> ExposeClosures -> Bool) -> Eq ExposeClosures
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)

-- | Given a type find the typeclasses the type belongs to, and return
-- the representation of the type in the function signature and the
-- list of typeclass constraints for the type.
argumentType :: Type -> ExposeClosures -> CodeGen (Text, [Text])
argumentType :: Type -> ExposeClosures -> CodeGen (Text, [Text])
argumentType (TGList Type
a) ExposeClosures
expose = do
  (Text
name, [Text]
constraints) <- Type -> ExposeClosures -> CodeGen (Text, [Text])
argumentType Type
a ExposeClosures
expose
  (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]", [Text]
constraints)
argumentType (TGSList Type
a) ExposeClosures
expose = do
  (Text
name, [Text]
constraints) <- Type -> ExposeClosures -> CodeGen (Text, [Text])
argumentType Type
a ExposeClosures
expose
  (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]", [Text]
constraints)
argumentType Type
t ExposeClosures
expose = do
  Maybe API
api <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  Text
s <- TypeRep -> Text
typeShow (TypeRep -> Text)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
haskellType Type
t
  case Maybe API
api of
    -- Instead of restricting to the actual class,
    -- we allow for any object descending from it.
    Just (APIInterface Interface
_) -> do
      Text
cls <- Type -> CodeGen Text
typeConstraint Type
t
      Text
l <- ReaderT
  CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
CodeGen Text
getFreshTypeVariable
      (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
l, [Text
cls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l])
    Just (APIObject Object
_) -> do
      Text
cls <- Type -> CodeGen Text
typeConstraint Type
t
      Text
l <- ReaderT
  CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
CodeGen Text
getFreshTypeVariable
      (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
l, [Text
cls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l])
    Just (APICallback Callback
cb) ->
      -- See [Note: Callables that throw]
      if Callable -> Bool
callableThrows (Callback -> Callable
cbCallable Callback
cb)
      then do
        Text
ft <- TypeRep -> Text
typeShow (TypeRep -> Text)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
foreignType Type
t
        (Text, [Text]) -> BaseCodeGen e (Text, [Text])
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 (TypeRep -> Text)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
isoHaskellType Type
t
            (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s_withClosures, [])
          ExposeClosures
WithoutClosures ->
            (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, [])
    Maybe API
_ -> (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, [])

haskellBasicType :: BasicType -> TypeRep
haskellBasicType :: BasicType -> TypeRep
haskellBasicType BasicType
TPtr      = TypeRep -> TypeRep
ptr (TypeRep -> TypeRep) -> TypeRep -> TypeRep
forall a b. (a -> b) -> a -> b
$ Text -> TypeRep
con0 Text
"()"
haskellBasicType BasicType
TBoolean  = Text -> TypeRep
con0 Text
"Bool"
-- For all the platforms that we support (and those supported by glib)
-- we have gint == gint32. Encoding this assumption in the types saves
-- conversions.
haskellBasicType BasicType
TInt      = case CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
0 :: CInt) of
                               Int
4 -> Text -> TypeRep
con0 Text
"Int32"
                               Int
n -> String -> TypeRep
forall a. HasCallStack => String -> a
error (String
"Unsupported `gint' length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                           Int -> String
forall a. Show a => a -> String
show Int
n)
haskellBasicType BasicType
TUInt     = case CUInt -> Int
forall a. Storable a => a -> Int
sizeOf (CUInt
0 :: CUInt) of
                               Int
4 -> Text -> TypeRep
con0 Text
"Word32"
                               Int
n -> String -> TypeRep
forall a. HasCallStack => String -> a
error (String
"Unsupported `guint' length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                           Int -> String
forall a. Show a => a -> String
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"

-- | This translates GI types to the types used for generated Haskell code.
haskellType :: Type -> CodeGen TypeRep
haskellType :: Type -> CodeGen TypeRep
haskellType (TBasicType BasicType
bt) = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ BasicType -> TypeRep
haskellBasicType BasicType
bt
-- There is no great choice in this case, so we simply pass the
-- pointer along. This is useful for GdkPixbufNotify, for example.
haskellType t :: Type
t@(TCArray Bool
False (-1) (-1) (TBasicType BasicType
TUInt8)) =
  Type -> CodeGen TypeRep
foreignType Type
t
haskellType (TCArray Bool
_ Int
_ Int
_ (TBasicType BasicType
TUInt8)) =
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"ByteString" Text -> [TypeRep] -> TypeRep
`con` []
haskellType (TCArray Bool
_ Int
_ Int
_ Type
a) = do
  TypeRep
inner <- Type -> CodeGen TypeRep
haskellType Type
a
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TGArray Type
a) = do
  TypeRep
inner <- Type -> CodeGen TypeRep
haskellType Type
a
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TPtrArray Type
a) = do
  TypeRep
inner <- Type -> CodeGen TypeRep
haskellType Type
a
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (Type
TByteArray) = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"ByteString" Text -> [TypeRep] -> TypeRep
`con` []
haskellType (TGList Type
a) = do
  TypeRep
inner <- Type -> CodeGen TypeRep
haskellType Type
a
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TGSList Type
a) = do
  TypeRep
inner <- Type -> CodeGen TypeRep
haskellType Type
a
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"[]" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TGHash Type
a Type
b) = do
  TypeRep
innerA <- Type -> CodeGen TypeRep
haskellType Type
a
  TypeRep
innerB <- Type -> CodeGen TypeRep
haskellType Type
b
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"Map.Map" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
innerA, TypeRep
innerB]
haskellType Type
TError = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"GError" Text -> [TypeRep] -> TypeRep
`con` []
haskellType Type
TVariant = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"GVariant" Text -> [TypeRep] -> TypeRep
`con` []
haskellType Type
TParamSpec = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
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 <- HasCallStack => Type -> CodeGen API
Type -> CodeGen 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 <- Text -> Name -> CodeGen Text
qualifiedSymbol (Text -> Text
callbackCType (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Text
name Name
n') Name
n
      TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"GClosure" Text -> [TypeRep] -> TypeRep
`con` [Text -> TypeRep
con0 Text
tname]
    -- The given inner type does not make sense, so we treat it as an
    -- untyped closure.
    API
_ -> Type -> CodeGen TypeRep
haskellType (Maybe Type -> Type
TGClosure Maybe Type
forall a. Maybe a
Nothing)
haskellType (TGClosure Maybe Type
_) = do
  Text
tyvar <- BaseCodeGen e Text
CodeGen Text
getFreshTypeVariable
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"GClosure" Text -> [TypeRep] -> TypeRep
`con` [Text -> TypeRep
con0 Text
tyvar]
haskellType Type
TGValue = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ Text
"GValue" Text -> [TypeRep] -> TypeRep
`con` []
haskellType t :: Type
t@(TInterface Name
n) = do
  API
api <- HasCallStack => Type -> CodeGen API
Type -> CodeGen API
getAPI Type
t
  Text
tname <- API -> Name -> CodeGen Text
qualifiedAPI API
api Name
n
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
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` []

-- | Whether the callable has closure arguments (i.e. "user_data"
-- style arguments).
callableHasClosures :: Callable -> Bool
callableHasClosures :: Callable -> Bool
callableHasClosures = (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) ([Int] -> Bool) -> (Callable -> [Int]) -> Callable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arg -> Int) -> [Arg] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> Int
argClosure ([Arg] -> [Int]) -> (Callable -> [Arg]) -> Callable -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Callable -> [Arg]
args

-- | Check whether the given type corresponds to a callback.
typeIsCallback :: Type -> CodeGen Bool
typeIsCallback :: Type -> CodeGen Bool
typeIsCallback t :: Type
t@(TInterface Name
_) = do
  Maybe API
api <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
api of
    Just (APICallback Callback
_) -> Bool -> BaseCodeGen e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Maybe API
_ -> Bool -> BaseCodeGen e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
typeIsCallback Type
_ = Bool -> BaseCodeGen e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Basically like `haskellType`, but for types which admit a
-- "isomorphic" version of the Haskell type distinct from the usual
-- Haskell type.  Generally the Haskell type we expose is isomorphic
-- to the foreign type, but in some cases, such as callbacks with
-- closure arguments, this does not hold, as we omit the closure
-- arguments. This function returns a type which is actually
-- isomorphic. There is another case this function deals with: for
-- convenience untyped `TGClosure` types have a type variable on the
-- Haskell side when they are arguments to functions, but we do not
-- want this when they appear as arguments to callbacks/signals, or
-- return types of properties, as it would force the type synonym/type
-- family to depend on the type variable.
isoHaskellType :: Type -> CodeGen TypeRep
isoHaskellType :: Type -> CodeGen TypeRep
isoHaskellType (TGClosure Maybe Type
Nothing) =
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
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 <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
api of
    Just apiCB :: API
apiCB@(APICallback Callback
cb) -> do
        Text
tname <- API -> Name -> CodeGen Text
qualifiedAPI API
apiCB Name
n
        if Callable -> Bool
callableHasClosures (Callback -> Callable
cbCallable Callback
cb)
        then TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text -> Text
callbackHTypeWithClosures Text
tname) Text -> [TypeRep] -> TypeRep
`con` [])
        else TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
tname Text -> [TypeRep] -> TypeRep
`con` [])
    Maybe API
_ -> Type -> CodeGen TypeRep
haskellType Type
t
isoHaskellType Type
t = Type -> CodeGen TypeRep
haskellType Type
t

-- | Foreign (C) type associated to one of the basic types.
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

-- This translates GI types to the types used in foreign function calls.
foreignType :: Type -> CodeGen TypeRep
foreignType :: Type -> CodeGen TypeRep
foreignType (TBasicType BasicType
t) = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ BasicType -> TypeRep
foreignBasicType BasicType
t
foreignType (TCArray Bool
_ Int
_ Int
_ Type
TGValue) = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
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 <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bool
zt
  then TypeRep -> TypeRep
ptr (TypeRep -> TypeRep)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
foreignType Type
t
  else Type -> CodeGen TypeRep
foreignType Type
t
foreignType (TGArray Type
a) = do
  TypeRep
inner <- Type -> CodeGen TypeRep
foreignType Type
a
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
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 <- Type -> CodeGen TypeRep
foreignType Type
a
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"GPtrArray" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner])
foreignType (Type
TByteArray) = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ TypeRep -> TypeRep
ptr (Text
"GByteArray" Text -> [TypeRep] -> TypeRep
`con` [])
foreignType (TGList Type
a) = do
  TypeRep
inner <- Type -> CodeGen TypeRep
foreignType Type
a
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
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 <- Type -> CodeGen TypeRep
foreignType Type
a
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
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 <- Type -> CodeGen TypeRep
foreignType Type
a
  TypeRep
innerB <- Type -> CodeGen TypeRep
foreignType Type
b
  TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
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 (TypeRep -> TypeRep)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
haskellType Type
t
foreignType t :: Type
t@Type
TVariant = TypeRep -> TypeRep
ptr (TypeRep -> TypeRep)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
haskellType Type
t
foreignType t :: Type
t@Type
TParamSpec = TypeRep -> TypeRep
ptr (TypeRep -> TypeRep)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
haskellType Type
t
foreignType (TGClosure Maybe Type
Nothing) = TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
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 (TypeRep -> TypeRep)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
haskellType Type
t
foreignType t :: Type
t@(Type
TGValue) = TypeRep -> TypeRep
ptr (TypeRep -> TypeRep)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen TypeRep
haskellType Type
t
foreignType t :: Type
t@(TInterface Name
n) = do
  API
api <- HasCallStack => Type -> CodeGen API
Type -> CodeGen API
getAPI Type
t
  let enumIsSigned :: Enumeration -> Bool
enumIsSigned Enumeration
e = (Int64 -> Bool) -> [Int64] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0) ((EnumerationMember -> Int64) -> [EnumerationMember] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map EnumerationMember -> Int64
enumMemberValue (Enumeration -> [EnumerationMember]
enumMembers Enumeration
e))
      ctypeForEnum :: Enumeration -> p
ctypeForEnum Enumeration
e = if Enumeration -> Bool
enumIsSigned Enumeration
e
                       then p
"CInt"
                       else p
"CUInt"
  case API
api of
    APIEnum Enumeration
e -> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ (Enumeration -> Text
forall p. IsString p => Enumeration -> p
ctypeForEnum Enumeration
e) Text -> [TypeRep] -> TypeRep
`con` []
    APIFlags (Flags Enumeration
e) -> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep)
-> TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall a b. (a -> b) -> a -> b
$ (Enumeration -> Text
forall p. IsString p => Enumeration -> p
ctypeForEnum Enumeration
e) Text -> [TypeRep] -> TypeRep
`con` []
    APICallback Callback
_ -> do
      let n' :: Name
n' = API -> Name -> Name
normalizedAPIName API
api Name
n
      Text
tname <- Text -> Name -> CodeGen Text
qualifiedSymbol (Text -> Text
callbackCType (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Text
name Name
n') Name
n
      TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep -> TypeRep
funptr (TypeRep -> TypeRep) -> TypeRep -> TypeRep
forall a b. (a -> b) -> a -> b
$ Text
tname Text -> [TypeRep] -> TypeRep
`con` [])
    API
_ -> do
      Text
tname <- API -> Name -> CodeGen Text
qualifiedAPI API
api Name
n
      TypeRep
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) TypeRep
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRep -> TypeRep
ptr (TypeRep -> TypeRep) -> TypeRep -> TypeRep
forall a b. (a -> b) -> a -> b
$ Text
tname Text -> [TypeRep] -> TypeRep
`con` [])

-- | Whether the give type corresponds to an enum or flag.
typeIsEnumOrFlag :: Type -> CodeGen Bool
typeIsEnumOrFlag :: Type -> CodeGen Bool
typeIsEnumOrFlag Type
t = do
  Maybe API
a <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
a of
    Maybe API
Nothing -> Bool -> BaseCodeGen e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    (Just (APIEnum Enumeration
_)) -> Bool -> BaseCodeGen e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    (Just (APIFlags Flags
_)) -> Bool -> BaseCodeGen e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Maybe API
_ -> Bool -> BaseCodeGen e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Information on how to allocate a type: allocator function and
-- size of the struct.
data TypeAllocInfo = TypeAlloc Text Int

-- | Information on how to allocate the given type, if known.
typeAllocInfo :: Type -> CodeGen (Maybe TypeAllocInfo)
typeAllocInfo :: Type -> CodeGen (Maybe TypeAllocInfo)
typeAllocInfo Type
TGValue =
  let n :: Int
n = (Int
24)
{-# LINE 966 "lib/Data/GI/CodeGen/Conversions.hsc" #-}
  in return $ Just $ TypeAlloc ("SP.callocBytes " <> tshow n) n
typeAllocInfo (TGArray Type
t) = do
  Maybe API
api <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
api of
    Just (APIStruct Struct
s) -> case Struct -> Int
structSize Struct
s of
                            Int
0 -> Maybe TypeAllocInfo
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe TypeAllocInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeAllocInfo
forall a. Maybe a
Nothing
                            Int
n -> let allocator :: Text
allocator = Text
"B.GArray.allocGArray " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
                                 in Maybe TypeAllocInfo
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe TypeAllocInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TypeAllocInfo
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      (Maybe TypeAllocInfo))
-> Maybe TypeAllocInfo
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe TypeAllocInfo)
forall a b. (a -> b) -> a -> b
$ TypeAllocInfo -> Maybe TypeAllocInfo
forall a. a -> Maybe a
Just (TypeAllocInfo -> Maybe TypeAllocInfo)
-> TypeAllocInfo -> Maybe TypeAllocInfo
forall a b. (a -> b) -> a -> b
$ Text -> Int -> TypeAllocInfo
TypeAlloc Text
allocator Int
n
    Maybe API
_ -> Maybe TypeAllocInfo
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe TypeAllocInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeAllocInfo
forall a. Maybe a
Nothing
typeAllocInfo Type
t = do
  Maybe API
api <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
api of
    Just (APIStruct Struct
s) ->
      case Struct -> Int
structSize Struct
s of
        Int
0 -> Maybe TypeAllocInfo
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe TypeAllocInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeAllocInfo
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 Maybe TypeAllocInfo
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe TypeAllocInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TypeAllocInfo
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      (Maybe TypeAllocInfo))
-> Maybe TypeAllocInfo
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe TypeAllocInfo)
forall a b. (a -> b) -> a -> b
$ TypeAllocInfo -> Maybe TypeAllocInfo
forall a. a -> Maybe a
Just (TypeAllocInfo -> Maybe TypeAllocInfo)
-> TypeAllocInfo -> Maybe TypeAllocInfo
forall a b. (a -> b) -> a -> b
$ Text -> Int -> TypeAllocInfo
TypeAlloc (Text
allocator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n) Int
n
    Maybe API
_ -> Maybe TypeAllocInfo
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe TypeAllocInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeAllocInfo
forall a. Maybe a
Nothing

-- | Returns whether the given type corresponds to a `ManagedPtr`
-- instance (a thin wrapper over a `ForeignPtr`).
isManaged   :: Type -> CodeGen Bool
isManaged :: Type -> CodeGen Bool
isManaged Type
TError = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged Type
TVariant = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged Type
TGValue = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged Type
TParamSpec = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged (TGClosure Maybe Type
_) = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged t :: Type
t@(TInterface Name
_) = do
  Maybe API
a <- HasCallStack => Type -> CodeGen (Maybe API)
Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
a of
    Just (APIObject Object
_)    -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just (APIInterface Interface
_) -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just (APIStruct Struct
_)    -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just (APIUnion Union
_)     -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Maybe API
_                     -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isManaged Type
_ = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Returns whether the given type is represented by a pointer on the
-- C side.
typeIsPtr :: Type -> CodeGen Bool
typeIsPtr :: Type -> CodeGen Bool
typeIsPtr Type
t = Maybe FFIPtrType -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FFIPtrType -> Bool)
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe FFIPtrType)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen (Maybe FFIPtrType)
typePtrType Type
t

-- | Distinct types of foreign pointers.
data FFIPtrType = FFIPtr    -- ^ Ordinary `Ptr`.
                | FFIFunPtr -- ^ `FunPtr`.

-- | For those types represented by pointers on the C side, return the
-- type of pointer which represents them on the Haskell FFI.
typePtrType :: Type -> CodeGen (Maybe FFIPtrType)
typePtrType :: Type -> CodeGen (Maybe FFIPtrType)
typePtrType (TBasicType BasicType
TPtr) = Maybe FFIPtrType
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe FFIPtrType)
forall (m :: * -> *) a. Monad m => a -> m a
return (FFIPtrType -> Maybe FFIPtrType
forall a. a -> Maybe a
Just FFIPtrType
FFIPtr)
typePtrType (TBasicType BasicType
TUTF8) = Maybe FFIPtrType
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe FFIPtrType)
forall (m :: * -> *) a. Monad m => a -> m a
return (FFIPtrType -> Maybe FFIPtrType
forall a. a -> Maybe a
Just FFIPtrType
FFIPtr)
typePtrType (TBasicType BasicType
TFileName) = Maybe FFIPtrType
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe FFIPtrType)
forall (m :: * -> *) a. Monad m => a -> m a
return (FFIPtrType -> Maybe FFIPtrType
forall a. a -> Maybe a
Just FFIPtrType
FFIPtr)
typePtrType Type
t = do
  TypeRep
ft <- Type -> CodeGen TypeRep
foreignType Type
t
  case TypeRep -> Text
typeConName TypeRep
ft of
    Text
"Ptr"    -> Maybe FFIPtrType
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe FFIPtrType)
forall (m :: * -> *) a. Monad m => a -> m a
return (FFIPtrType -> Maybe FFIPtrType
forall a. a -> Maybe a
Just FFIPtrType
FFIPtr)
    Text
"FunPtr" -> Maybe FFIPtrType
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe FFIPtrType)
forall (m :: * -> *) a. Monad m => a -> m a
return (FFIPtrType -> Maybe FFIPtrType
forall a. a -> Maybe a
Just FFIPtrType
FFIFunPtr)
    Text
_        -> Maybe FFIPtrType
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe FFIPtrType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FFIPtrType
forall a. Maybe a
Nothing

-- | If the passed in type is nullable, return the conversion function
-- between the FFI pointer type (may be a `Ptr` or a `FunPtr`) and the
-- corresponding `Maybe` type.
maybeNullConvert :: Type -> CodeGen (Maybe Text)
maybeNullConvert :: Type -> CodeGen (Maybe Text)
maybeNullConvert (TBasicType BasicType
TPtr) = Maybe Text
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
maybeNullConvert (TGList Type
_) = Maybe Text
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
maybeNullConvert (TGSList Type
_) = Maybe Text
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
maybeNullConvert Type
t = do
  Maybe FFIPtrType
pt <- Type -> CodeGen (Maybe FFIPtrType)
typePtrType Type
t
  case Maybe FFIPtrType
pt of
    Just FFIPtrType
FFIPtr -> Maybe Text
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"SP.convertIfNonNull")
    Just FFIPtrType
FFIFunPtr -> Maybe Text
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"SP.convertFunPtrIfNonNull")
    Maybe FFIPtrType
Nothing -> Maybe Text
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

-- | An appropriate NULL value for the given type, for types which are
-- represented by pointers on the C side.
nullPtrForType :: Type -> CodeGen (Maybe Text)
nullPtrForType :: Type -> CodeGen (Maybe Text)
nullPtrForType Type
t = do
  Maybe FFIPtrType
pt <- Type -> CodeGen (Maybe FFIPtrType)
typePtrType Type
t
  case Maybe FFIPtrType
pt of
    Just FFIPtrType
FFIPtr -> Maybe Text -> BaseCodeGen e (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"FP.nullPtr")
    Just FFIPtrType
FFIFunPtr -> Maybe Text -> BaseCodeGen e (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"FP.nullFunPtr")
    Maybe FFIPtrType
Nothing -> Maybe Text -> BaseCodeGen e (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

-- | Returns whether the given type should be represented by a
-- `Maybe` type on the Haskell side. This applies to all properties
-- which have a C representation in terms of pointers, except for
-- G(S)Lists, for which NULL is a valid G(S)List, and raw pointers,
-- which we just pass through to the Haskell side. Notice that
-- introspection annotations can override this.
typeIsNullable :: Type -> CodeGen Bool
typeIsNullable :: Type -> CodeGen Bool
typeIsNullable Type
t = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe Text)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CodeGen (Maybe Text)
maybeNullConvert Type
t

-- | If the given type maps to a list in Haskell, return the type of the
-- elements, and the function that maps over them.
elementTypeAndMap :: Type -> Text -> Maybe (Type, Text)
-- ByteString
elementTypeAndMap :: Type -> Text -> Maybe (Type, Text)
elementTypeAndMap (TCArray Bool
_ Int
_ Int
_ (TBasicType BasicType
TUInt8)) Text
_ = Maybe (Type, Text)
forall a. Maybe a
Nothing
elementTypeAndMap (TCArray Bool
True Int
_ Int
_ Type
t) Text
_ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, Text
"mapZeroTerminatedCArray")
elementTypeAndMap (TCArray Bool
_ Int
_ Int
_ Type
TGValue) Text
len =
  (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
TGValue, Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"B.GValue.mapGValueArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
len)
elementTypeAndMap (TCArray Bool
False (-1) Int
_ Type
t) Text
len =
  (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"mapCArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
len)
elementTypeAndMap (TCArray Bool
False Int
fixed Int
_ Type
t) Text
_ =
  (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"mapCArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
fixed)
elementTypeAndMap (TGArray Type
t) Text
_ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, Text
"mapGArray")
elementTypeAndMap (TPtrArray Type
t) Text
_ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, Text
"mapPtrArray")
elementTypeAndMap (TGList Type
t) Text
_ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, Text
"mapGList")
elementTypeAndMap (TGSList Type
t) Text
_ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, Text
"mapGSList")
-- GHashTable is treated separately, see Transfer.hs
elementTypeAndMap Type
_ Text
_ = Maybe (Type, Text)
forall a. Maybe a
Nothing

-- Return just the element type.
elementType :: Type -> Maybe Type
elementType :: Type -> Maybe Type
elementType Type
t = (Type, Text) -> Type
forall a b. (a, b) -> a
fst ((Type, Text) -> Type) -> Maybe (Type, Text) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Text -> Maybe (Type, Text)
elementTypeAndMap Type
t Text
forall a. HasCallStack => a
undefined

-- Return just the map.
elementMap :: Type -> Text -> Maybe Text
elementMap :: Type -> Text -> Maybe Text
elementMap Type
t Text
len = (Type, Text) -> Text
forall a b. (a, b) -> b
snd ((Type, Text) -> Text) -> Maybe (Type, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Text -> Maybe (Type, Text)
elementTypeAndMap Type
t Text
len