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

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>), pure, Applicative)
#endif
import Control.Monad (when)
import Data.Maybe (isJust)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
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 f :: 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
a)  = b -> Free f b
forall (f :: * -> *) r. r -> Free f r
Pure (a -> b
f a
a)
    go (Free fa :: 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 :: a -> b
a <*> :: Free f (a -> b) -> Free f a -> Free f b
<*> Pure b :: 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 :: a -> b
a <*> Free mb :: 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 ma :: f (Free f (a -> b))
ma <*> b :: 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 x :: f (Free f a)
x) >>= :: Free f a -> (a -> Free f b) -> Free f b
>>= f :: 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 r :: a
r) >>= f :: 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 command :: 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"
mapName MapFirst = "mapFirst"
mapName MapSecond = "mapSecond"

-- Naming for the monadic versions of the maps that we use
monadicMapName :: Map -> Text
monadicMapName :: Map -> Text
monadicMapName Map = "mapM"
monadicMapName MapFirst = "mapFirstA"
monadicMapName MapSecond = "mapSecondA"

apply :: Constructor -> Converter
apply :: Constructor -> Converter
apply f :: 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 f :: 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 f :: 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 f :: 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 f :: 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 c :: 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 l :: Text
l (Pure ()) = Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
l
genConversion l :: Text
l (Free k :: FExpr Converter
k) = do
  let l' :: Text
l' = Text -> Text
prime Text
l
  case FExpr Converter
k of
    Apply (P f :: Text
f) next :: Converter
next ->
        do Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ "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
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next
    Apply (M f :: Text
f) next :: Converter
next ->
        do Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " <- " 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
forall a. Semigroup a => a -> a -> a
<> Text
l
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next
    Apply Id next :: Converter
next -> Text -> Converter -> CodeGen Text
genConversion Text
l Converter
next

    MapC m :: Map
m (P f :: Text
f) next :: Converter
next ->
        do Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ "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
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
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next
    MapC m :: Map
m (M f :: Text
f) next :: Converter
next ->
        do Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " <- " 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
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next
    MapC _ Id next :: Converter
next -> Text -> Converter -> CodeGen Text
genConversion Text
l Converter
next

    LambdaConvert conv :: Text
conv next :: Converter
next ->
        do Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text
conv Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " 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
forall a. Semigroup a => a -> a -> a
<> Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " -> do"
           BaseCodeGen e ()
CodeGen ()
increaseIndent
           Text -> Converter -> CodeGen Text
genConversion Text
l' Converter
next

    Literal (P f :: Text
f) next :: Converter
next ->
        do Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ "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
forall a. Semigroup a => a -> a -> a
<> Text
f
           Text -> Converter -> CodeGen Text
genConversion Text
l Converter
next
    Literal (M f :: Text
f) next :: Converter
next ->
        do Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " <- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f
           Text -> Converter -> CodeGen Text
genConversion Text
l Converter
next
    Literal Id next :: 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 array :: Text
array (TCArray _ _ _ t :: 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
$ "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
forall a. Semigroup a => a -> a -> a
<> Text
array
    where findReader :: ExcCodeGen Text
findReader = case Type
t of
                     TBasicType TUInt8 -> Text -> ExcCodeGen Text
forall (m :: * -> *) a. Monad m => a -> m a
return "B.length"
                     TBasicType _      -> Text -> ExcCodeGen Text
forall (m :: * -> *) a. Monad m => a -> m a
return "length"
                     TInterface _      -> Text -> ExcCodeGen Text
forall (m :: * -> *) a. Monad m => a -> m a
return "length"
                     TCArray{}         -> Text -> ExcCodeGen Text
forall (m :: * -> *) a. Monad m => a -> m a
return "length"
                     _ -> Text -> ExcCodeGen Text
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Text) -> Text -> ExcCodeGen Text
forall a b. (a -> b) -> a -> b
$
                          "Don't know how to compute length of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Show a => a -> Text
tshow Type
t
computeArrayLength _ t :: Type
t =
    Text -> ExcCodeGen Text
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Text) -> Text -> ExcCodeGen Text
forall a b. (a -> b) -> a -> b
$ "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 l :: Text
l c :: 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 t :: Type
t transfer :: 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 "B.ManagedPtr.disownObject"
    else Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
badIntroError "Transferring a non-GObject object"
  -- 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 "unsafeManagedPtrCastPtr"

hVariantToF :: Transfer -> CodeGen Constructor
hVariantToF :: Transfer -> CodeGen Constructor
hVariantToF transfer :: 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 "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 "unsafeManagedPtrGetPtr"

hParamSpecToF :: Transfer -> CodeGen Constructor
hParamSpecToF :: Transfer -> CodeGen Constructor
hParamSpecToF transfer :: 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 "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 "unsafeManagedPtrGetPtr"

hClosureToF :: Transfer -> Maybe Type -> CodeGen Constructor
-- Untyped closures
hClosureToF :: Transfer -> Maybe Type -> CodeGen Constructor
hClosureToF transfer :: Transfer
transfer 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 "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 "unsafeManagedPtrCastPtr"
-- Typed closures
hClosureToF transfer :: Transfer
transfer (Just _) =
  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 "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 "unsafeManagedPtrGetPtr"

hBoxedToF :: Transfer -> CodeGen Constructor
hBoxedToF :: Transfer -> CodeGen Constructor
hBoxedToF transfer :: 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 "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 "unsafeManagedPtrGetPtr"

hStructToF :: Struct -> Transfer -> ExcCodeGen Constructor
hStructToF :: Struct -> Transfer -> ExcCodeGen Constructor
hStructToF s :: Struct
s transfer :: 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
== 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 "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 "unsafeManagedPtrGetPtr"

hUnionToF :: Union -> Transfer -> ExcCodeGen Constructor
hUnionToF :: Union -> Transfer -> ExcCodeGen Constructor
hUnionToF u :: Union
u transfer :: 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
== 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 "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 "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' t :: Type
t a :: Maybe API
a hType :: TypeRep
hType fType :: TypeRep
fType transfer :: 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
TParamSpec <- Type
t = Transfer -> CodeGen Constructor
hParamSpecToF Transfer
transfer
    | TGClosure c :: Maybe Type
c <- Type
t = Transfer -> Maybe Type -> CodeGen Constructor
hClosureToF Transfer
transfer Maybe Type
c
    | Just (APIEnum _) <- Maybe API
a = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "(fromIntegral . fromEnum)"
    | Just (APIFlags _) <- Maybe API
a = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "gflagsToWord"
    | Just (APIObject _) <- Maybe API
a = Type -> Transfer -> ExcCodeGen Constructor
hObjectToF Type
t Transfer
transfer
    | Just (APIInterface _) <- Maybe API
a = Type -> Transfer -> ExcCodeGen Constructor
hObjectToF Type
t Transfer
transfer
    | Just (APIStruct s :: Struct
s) <- Maybe API
a = Struct -> Transfer -> ExcCodeGen Constructor
hStructToF Struct
s Transfer
transfer
    | Just (APIUnion u :: 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 _) <- Maybe API
a = String -> ExcCodeGen Constructor
forall a. HasCallStack => String -> a
error "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 "packGByteArray"
    | TCArray True _ _ (TBasicType 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 "packZeroTerminatedUTF8CArray"
    | TCArray True _ _ (TBasicType 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 "packZeroTerminatedFileNameArray"
    | TCArray True _ _ (TBasicType 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 "packZeroTerminatedPtrArray"
    | TCArray True _ _ (TBasicType 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 "packZeroTerminatedByteString"
    | TCArray True _ _ (TBasicType 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 "(packMapZeroTerminatedStorableArray (fromIntegral . fromEnum))"
    | TCArray True _ _ (TBasicType 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 "(packMapZeroTerminatedStorableArray gtypeToCGtype)"
    | TCArray True _ _ (TBasicType _) <- 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 "packZeroTerminatedStorableArray"
    | TCArray False _ _ (TBasicType 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 "packUTF8CArray"
    | TCArray False _ _ (TBasicType 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 "packFileNameArray"
    | TCArray False _ _ (TBasicType 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 "packPtrArray"
    | TCArray False _ _ (TBasicType 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 "packByteString"
    | TCArray False _ _ (TBasicType 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 "(packMapStorableArray (fromIntegral . fromEnum))"
    | TCArray False _ _ (TBasicType 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 "(packMapStorableArray gtypeToCGType)"
    | TCArray False _ _ (TBasicType 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 "(packMapStorableArray realToFrac)"
    | TCArray False _ _ (TBasicType 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 "(packMapStorableArray realToFrac)"
    | TCArray False _ _ (TBasicType _) <- 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 "packStorableArray"
    | 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
$
                   "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
               ("T.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 "textToCString"
               ("[Char]", "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 "stringToCString"
               ("Char", "CInt")      -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "(fromIntegral . ord)"
               ("Bool", "CInt")      -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "(fromIntegral . fromEnum)"
               ("Float", "CFloat")   -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "realToFrac"
               ("Double", "CDouble") -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "realToFrac"
               ("GType", "CGType")   -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "gtypeToCGType"
               _                     -> Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Constructor) -> Text -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$
                                        "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
<> " 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
<> ".\n"
                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "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 t :: Type
t transfer :: Transfer
transfer = do
  Maybe API
a <- 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 t :: Type
t packer :: Text
packer transfer :: 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 TPtr) = (Text, Text) -> ExcCodeGen (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ("gDirectHash", "gDirectEqual")
hashTableKeyMappings (TBasicType TUTF8) = (Text, Text) -> ExcCodeGen (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ("gStrHash", "gStrEqual")
hashTableKeyMappings t :: 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
$ "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
<> " 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 TPtr) =
    (Text, Text, Text) -> ExcCodeGen (Text, Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ("Nothing", "ptrPackPtr", "ptrUnpackPtr")
hashTablePtrPackers (TBasicType TUTF8) =
    (Text, Text, Text) -> ExcCodeGen (Text, Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ("(Just ptr_to_g_free)", "cstringPackPtr", "cstringUnpackPtr")
hashTablePtrPackers t :: 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
$ "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
<> " unsupported."

hToF_PackGHashTable :: Type -> Type -> ExcCodeGen Converter
hToF_PackGHashTable :: Type -> Type -> ExcCodeGen Converter
hToF_PackGHashTable keys :: Type
keys elems :: 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
  (keyHash :: Text
keyHash, keyEqual :: Text
keyEqual) <- Type -> ExcCodeGen (Text, Text)
hashTableKeyMappings Type
keys
  (keyDestroy :: Text
keyDestroy, keyPack :: Text
keyPack, _) <- Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers Type
keys
  (elemDestroy :: Text
elemDestroy, elemPack :: Text
elemPack, _) <- 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 "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 " " ["packGHashTable", Text
keyHash, Text
keyEqual,
                                 Text
keyDestroy, Text
elemDestroy]))

hToF :: Type -> Transfer -> ExcCodeGen Converter
hToF :: Type -> Transfer -> ExcCodeGen Converter
hToF (TGList t :: Type
t) transfer :: 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
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
<>
                      "' is not a pointer type, cannot pack into a GList.")
  Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t "packGList" Transfer
transfer
hToF (TGSList t :: Type
t) transfer :: 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
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
<>
                      "' is not a pointer type, cannot pack into a GSList.")
  Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t "packGSList" Transfer
transfer
hToF (TGArray t :: Type
t) transfer :: Transfer
transfer = Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t "packGArray" Transfer
transfer
hToF (TPtrArray t :: Type
t) transfer :: Transfer
transfer = Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t "packGPtrArray" Transfer
transfer
hToF (TGHash ta :: Type
ta tb :: Type
tb) _ = Type -> Type -> ExcCodeGen Converter
hToF_PackGHashTable Type
ta Type
tb
hToF (TCArray zt :: Bool
zt _ _ t :: Type
t@(TCArray{})) transfer :: Transfer
transfer = do
  let packer :: Text
packer = if Bool
zt
               then "packZeroTerminated"
               else "pack"
  Type -> Text -> Transfer -> ExcCodeGen Converter
hToF_PackedType Type
t (Text
packer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "PtrArray") Transfer
transfer

hToF (TCArray zt :: Bool
zt _ _ t :: Type
t@(TInterface _)) transfer :: Transfer
transfer = do
  Bool
isScalar <- Type -> CodeGen Bool
typeIsEnumOrFlag Type
t
  let packer :: Text
packer = if Bool
zt
               then "packZeroTerminated"
               else "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
<> "StorableArray") Transfer
transfer
  else do
    Maybe API
api <- Type -> CodeGen (Maybe API)
findAPI Type
t
    let size :: Int
size = case Maybe API
api of
                 Just (APIStruct s :: Struct
s) -> Struct -> Int
structSize Struct
s
                 Just (APIUnion u :: Union
u) -> Union -> Int
unionSize Union
u
                 _ -> 0
    if Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
<> "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
<> "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 t :: Type
t transfer :: Transfer
transfer = do
  Maybe API
a <- 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 constructor :: Text
constructor transfer :: 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
     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
$ "wrapBoxed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
     _ -> 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
$ "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 isBoxed :: Bool
isBoxed hType :: TypeRep
hType transfer :: 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
         TransferEverything -> "wrapPtr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
         _ -> "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 s :: 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 u :: 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 t :: Type
t hType :: TypeRep
hType transfer :: 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
    TransferEverything ->
        if Bool
isGO
        then "wrapObject " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
        else "wrapPtr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
    _ ->
        if Bool
isGO
        then "newObject " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor
        else "newPtr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor

fCallbackToH :: TypeRep -> Transfer -> ExcCodeGen Constructor
fCallbackToH :: TypeRep -> Transfer -> ExcCodeGen Constructor
fCallbackToH hType :: TypeRep
hType 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 _ transfer :: Transfer
transfer =
  Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
notImplementedError ("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
<> "'")

fVariantToH :: Transfer -> CodeGen Constructor
fVariantToH :: Transfer -> CodeGen Constructor
fVariantToH transfer :: 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
                  TransferEverything -> "B.GVariant.wrapGVariantPtr"
                  _ -> "B.GVariant.newGVariantFromPtr"

fParamSpecToH :: Transfer -> CodeGen Constructor
fParamSpecToH :: Transfer -> CodeGen Constructor
fParamSpecToH transfer :: 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
                  TransferEverything -> "B.GParamSpec.wrapGParamSpecPtr"
                  _ -> "B.GParamSpec.newGParamSpecFromPtr"

fClosureToH :: Transfer -> Maybe Type -> CodeGen Constructor
-- Untyped closures
fClosureToH :: Transfer -> Maybe Type -> CodeGen Constructor
fClosureToH transfer :: Transfer
transfer 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
                  TransferEverything ->
                    Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ "B.GClosure.wrapGClosurePtr . FP.castPtr"
                  _ -> Text -> Text
parenthesize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ "B.GClosure.newGClosureFromPtr . FP.castPtr"
-- Typed closures
fClosureToH transfer :: Transfer
transfer (Just _) =
  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
                  TransferEverything -> "B.GClosure.wrapGClosurePtr"
                  _ -> "B.GClosure.newGClosureFromPtr"

fToH' :: Type -> Maybe API -> TypeRep -> TypeRep -> Transfer
         -> ExcCodeGen Constructor
fToH' :: Type
-> Maybe API
-> TypeRep
-> TypeRep
-> Transfer
-> ExcCodeGen Constructor
fToH' t :: Type
t a :: Maybe API
a hType :: TypeRep
hType fType :: TypeRep
fType transfer :: 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 _) <- Maybe API
a = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "(toEnum . fromIntegral)"
    | Just (APIFlags _) <- Maybe API
a = Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "wordToGFlags"
    | Type
TError <- Type
t = Text -> Transfer -> CodeGen Constructor
boxedForeignPtr "GError" Transfer
transfer
    | Type
TVariant <- Type
t = Transfer -> CodeGen Constructor
fVariantToH Transfer
transfer
    | Type
TParamSpec <- Type
t = Transfer -> CodeGen Constructor
fParamSpecToH Transfer
transfer
    | TGClosure c :: Maybe Type
c <- Type
t = Transfer -> Maybe Type -> CodeGen Constructor
fClosureToH Transfer
transfer Maybe Type
c
    | Just (APIStruct s :: Struct
s) <- Maybe API
a = Struct -> TypeRep -> Transfer -> CodeGen Constructor
structForeignPtr Struct
s TypeRep
hType Transfer
transfer
    | Just (APIUnion u :: Union
u) <- Maybe API
a = Union -> TypeRep -> Transfer -> CodeGen Constructor
unionForeignPtr Union
u TypeRep
hType Transfer
transfer
    | Just (APIObject _) <- Maybe API
a = Type -> TypeRep -> Transfer -> ExcCodeGen Constructor
fObjectToH Type
t TypeRep
hType Transfer
transfer
    | Just (APIInterface _) <- Maybe API
a = Type -> TypeRep -> Transfer -> ExcCodeGen Constructor
fObjectToH Type
t TypeRep
hType Transfer
transfer
    | Just (APICallback _) <- Maybe API
a = TypeRep -> Transfer -> ExcCodeGen Constructor
fCallbackToH TypeRep
hType Transfer
transfer
    | TCArray True _ _ (TBasicType 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 "unpackZeroTerminatedUTF8CArray"
    | TCArray True _ _ (TBasicType 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 "unpackZeroTerminatedFileNameArray"
    | TCArray True _ _ (TBasicType 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 "unpackZeroTerminatedByteString"
    | TCArray True _ _ (TBasicType 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 "unpackZeroTerminatedPtrArray"
    | TCArray True _ _ (TBasicType 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 "(unpackMapZeroTerminatedStorableArray (/= 0))"
    | TCArray True _ _ (TBasicType 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 "(unpackMapZeroTerminatedStorableArray GType)"
    | TCArray True _ _ (TBasicType 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 "(unpackMapZeroTerminatedStorableArray realToFrac)"
    | TCArray True _ _ (TBasicType 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 "(unpackMapZeroTerminatedStorableArray realToFrac)"
    | TCArray True _ _ (TBasicType _) <- 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 "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
$
                   "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 "unpackGByteArray"
    | TGHash _ _ <- Type
t = Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
notImplementedError "Foreign Hashes not supported yet"
    | Bool
otherwise = case (TypeRep -> Text
typeShow TypeRep
fType, TypeRep -> Text
typeShow TypeRep
hType) of
               ("CString", "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 "cstringToText"
               ("CString", "[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 "cstringToString"
               ("CInt", "Char")      -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "(chr . fromIntegral)"
               ("CInt", "Bool")      -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "(/= 0)"
               ("CFloat", "Float")   -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "realToFrac"
               ("CDouble", "Double") -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "realToFrac"
               ("CGType", "GType")   -> Constructor -> ExcCodeGen Constructor
forall (m :: * -> *) a. Monad m => a -> m a
return "GType"
               _                     ->
                   Text -> ExcCodeGen Constructor
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Constructor) -> Text -> ExcCodeGen Constructor
forall a b. (a -> b) -> a -> b
$ "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
<> " 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
<> ".\n"
                                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "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 t :: Type
t transfer :: Transfer
transfer = do
  Maybe API
a <- 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 t :: Type
t unpacker :: Text
unpacker transfer :: 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 keys :: Type
keys elems :: Type
elems transfer :: Transfer
transfer = do
  Constructor
keysConstructor <- Type -> Transfer -> ExcCodeGen Constructor
getHaskellConstructor Type
keys Transfer
transfer
  (_,_,keysUnpack :: Text
keysUnpack) <- Type -> ExcCodeGen (Text, Text, Text)
hashTablePtrPackers Type
keys
  Constructor
elemsConstructor <- Type -> Transfer -> ExcCodeGen Constructor
getHaskellConstructor Type
elems Transfer
transfer
  (_,_,elemsUnpack :: 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 "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 "Map.fromList")

fToH :: Type -> Transfer -> ExcCodeGen Converter
fToH :: Type -> Transfer -> ExcCodeGen Converter
fToH (TGList t :: Type
t) transfer :: 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
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
<>
                      "' is not a pointer type, cannot unpack from a GList.")
  Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t "unpackGList" Transfer
transfer
fToH (TGSList t :: Type
t) transfer :: 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
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
<>
                      "' is not a pointer type, cannot unpack from a GSList.")
  Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t "unpackGSList" Transfer
transfer
fToH (TGArray t :: Type
t) transfer :: Transfer
transfer = Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t "unpackGArray" Transfer
transfer
fToH (TPtrArray t :: Type
t) transfer :: Transfer
transfer = Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t "unpackGPtrArray" Transfer
transfer
fToH (TGHash a :: Type
a b :: Type
b) transfer :: 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 False (-1) (-1) _) _ =
  Text -> ExcCodeGen Converter
forall a. Text -> ExcCodeGen a
badIntroError ("`" 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
<>
                  "' is an array type, but contains no length information.")
fToH (TCArray True _ _ t :: Type
t@(TCArray{})) transfer :: Transfer
transfer =
  Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t "unpackZeroTerminatedPtrArray" Transfer
transfer
fToH (TCArray True _ _ t :: Type
t@(TInterface _)) transfer :: Transfer
transfer = do
  Bool
isScalar <- Type -> CodeGen Bool
typeIsEnumOrFlag Type
t
  if Bool
isScalar
  then Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t "unpackZeroTerminatedStorableArray" Transfer
transfer
  else Type -> Text -> Transfer -> ExcCodeGen Converter
fToH_PackedType Type
t "unpackZeroTerminatedPtrArray" Transfer
transfer

fToH t :: Type
t transfer :: Transfer
transfer = do
  Maybe API
a <- 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 _) TransferNothing = do
  Maybe API
a <- Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
a of
    Just (APIStruct s :: 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 u :: 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
    _ -> Type -> Transfer -> ExcCodeGen Converter
fToH Type
t Transfer
TransferNothing
transientToH t :: Type
t transfer :: Transfer
transfer = Type -> Transfer -> ExcCodeGen Converter
fToH Type
t Transfer
transfer

-- | Wrap the given transient.
wrapTransient :: Type -> CodeGen Converter
wrapTransient :: Type -> CodeGen Converter
wrapTransient t :: 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
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Converter
forall (m :: * -> *) a. Monad m => a -> m a
return (Converter
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Converter)
-> Converter
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Converter
forall a b. (a -> b) -> a -> b
$ Text -> Converter
lambdaConvert (Text -> Converter) -> Text -> Converter
forall a b. (a -> b) -> a -> b
$ "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 length :: Text
length (TCArray False _ _ t :: Type
t) transfer :: Transfer
transfer =
  case Type
t of
    TBasicType 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
$
                        "unpackUTF8CArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType 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
$
                            "unpackFileNameArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType 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
$
                         "unpackByteStringWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType 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
$
                         "unpackPtrArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType 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
$
                         "unpackMapStorableArrayWithLength (/= 0) " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType 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
$
                         "unpackMapStorableArrayWithLength GType " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType 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
$
                         "unpackMapStorableArrayWithLength realToFrac " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType 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
$
                         "unpackMapStorableArrayWithLength realToFrac " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TBasicType _ -> 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
$
                         "unpackStorableArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
length
    TInterface _ -> do
           Maybe API
a <- 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
           Constructor
innerConstructor <- Type
-> Maybe API
-> TypeRep
-> TypeRep
-> Transfer
-> ExcCodeGen Constructor
fToH' Type
t Maybe API
a TypeRep
hType TypeRep
fType Transfer
transfer
           let (boxed :: Bool
boxed, size :: Int
size) = case Maybe API
a of
                        Just (APIStruct s :: Struct
s) -> (Struct -> Bool
structIsBoxed Struct
s, Struct -> Int
structSize Struct
s)
                        Just (APIUnion u :: Union
u) -> (Union -> Bool
unionIsBoxed Union
u, Union -> Int
unionSize Union
u)
                        _ -> (Bool
False, 0)
           let unpacker :: Text
unpacker | Bool
isScalar    = "unpackStorableArrayWithLength"
                        | (Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) = "unpackPtrArrayWithLength"
                        | Bool
boxed       = "unpackBoxedArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
size
                        | Bool
otherwise   = "unpackBlockArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
size
           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
forall a. Semigroup a => a -> a -> a
<> Text
length
             Constructor -> Converter
mapC Constructor
innerConstructor
    _ -> Text -> ExcCodeGen Converter
forall a. Text -> ExcCodeGen a
notImplementedError (Text -> ExcCodeGen Converter) -> Text -> ExcCodeGen Converter
forall a b. (a -> b) -> a -> b
$
         "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 -> ExcCodeGen Converter
forall a. Text -> ExcCodeGen a
notImplementedError "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 a :: Type
a) expose :: ExposeClosures
expose = do
  (name :: Text
name, constraints :: [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
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]", [Text]
constraints)
argumentType (TGSList a :: Type
a) expose :: ExposeClosures
expose = do
  (name :: Text
name, constraints :: [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
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]", [Text]
constraints)
argumentType t :: Type
t expose :: ExposeClosures
expose = do
  Maybe API
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 _) -> 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
forall a. Semigroup a => a -> a -> a
<> Text
l])
    Just (APIObject _) -> do
      Bool
isGO <- Type -> CodeGen Bool
isGObject Type
t
      if Bool
isGO
        then 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
forall a. Semigroup a => a -> a -> a
<> Text
l])
        else (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, [])
    Just (APICallback cb :: 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
          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, [])
          WithoutClosures ->
            (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, [])
    _ -> (Text, [Text]) -> BaseCodeGen e (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, [])

haskellBasicType :: BasicType -> TypeRep
haskellBasicType :: BasicType -> TypeRep
haskellBasicType TPtr      = TypeRep -> TypeRep
ptr (TypeRep -> TypeRep) -> TypeRep -> TypeRep
forall a b. (a -> b) -> a -> b
$ Text -> TypeRep
con0 "()"
haskellBasicType TBoolean  = Text -> TypeRep
con0 "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 TInt      = case CInt -> Int
forall a. Storable a => a -> Int
sizeOf (0 :: CInt) of
                               4 -> Text -> TypeRep
con0 "Int32"
                               n :: Int
n -> String -> TypeRep
forall a. HasCallStack => String -> a
error ("Unsupported `gint' length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                           Int -> String
forall a. Show a => a -> String
show Int
n)
haskellBasicType TUInt     = case CUInt -> Int
forall a. Storable a => a -> Int
sizeOf (0 :: CUInt) of
                               4 -> Text -> TypeRep
con0 "Word32"
                               n :: Int
n -> String -> TypeRep
forall a. HasCallStack => String -> a
error ("Unsupported `guint' length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                           Int -> String
forall a. Show a => a -> String
show Int
n)
haskellBasicType TLong     = Text -> TypeRep
con0 "CLong"
haskellBasicType TULong    = Text -> TypeRep
con0 "CULong"
haskellBasicType TInt8     = Text -> TypeRep
con0 "Int8"
haskellBasicType TUInt8    = Text -> TypeRep
con0 "Word8"
haskellBasicType TInt16    = Text -> TypeRep
con0 "Int16"
haskellBasicType TUInt16   = Text -> TypeRep
con0 "Word16"
haskellBasicType TInt32    = Text -> TypeRep
con0 "Int32"
haskellBasicType TUInt32   = Text -> TypeRep
con0 "Word32"
haskellBasicType TInt64    = Text -> TypeRep
con0 "Int64"
haskellBasicType TUInt64   = Text -> TypeRep
con0 "Word64"
haskellBasicType TGType    = Text -> TypeRep
con0 "GType"
haskellBasicType TUTF8     = Text -> TypeRep
con0 "T.Text"
haskellBasicType TFloat    = Text -> TypeRep
con0 "Float"
haskellBasicType TDouble   = Text -> TypeRep
con0 "Double"
haskellBasicType TUniChar  = Text -> TypeRep
con0 "Char"
haskellBasicType TFileName = Text -> TypeRep
con0 "[Char]"
haskellBasicType TIntPtr   = Text -> TypeRep
con0 "CIntPtr"
haskellBasicType TUIntPtr  = Text -> TypeRep
con0 "CUIntPtr"

-- | This translates GI types to the types used for generated Haskell code.
haskellType :: Type -> CodeGen TypeRep
haskellType :: Type -> CodeGen TypeRep
haskellType (TBasicType bt :: 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 False (-1) (-1) (TBasicType TUInt8)) =
  Type -> CodeGen TypeRep
foreignType Type
t
haskellType (TCArray _ _ _ (TBasicType 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
$ "ByteString" Text -> [TypeRep] -> TypeRep
`con` []
haskellType (TCArray _ _ _ a :: 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 -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TGArray a :: 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 -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TPtrArray a :: 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 -> [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
$ "ByteString" Text -> [TypeRep] -> TypeRep
`con` []
haskellType (TGList a :: 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 -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TGSList a :: 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 -> [TypeRep] -> TypeRep
`con` [TypeRep
inner]
haskellType (TGHash a :: Type
a b :: 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
$ "Map.Map" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
innerA, TypeRep
innerB]
haskellType 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
$ "GError" Text -> [TypeRep] -> TypeRep
`con` []
haskellType 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
$ "GVariant" Text -> [TypeRep] -> TypeRep
`con` []
haskellType 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
$ "GParamSpec" Text -> [TypeRep] -> TypeRep
`con` []
haskellType (TGClosure (Just inner :: Type
inner@(TInterface n :: Name
n))) = do
  API
innerAPI <- Type -> CodeGen API
getAPI Type
inner
  case API
innerAPI of
    APICallback _ -> do
      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
$ "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.
    _ -> Type -> CodeGen TypeRep
haskellType (Maybe Type -> Type
TGClosure Maybe Type
forall a. Maybe a
Nothing)
haskellType (TGClosure _) = 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
$ "GClosure" Text -> [TypeRep] -> TypeRep
`con` [Text -> TypeRep
con0 Text
tyvar]
haskellType (TInterface (Name "GObject" "Value")) = 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
$ "GValue" Text -> [TypeRep] -> TypeRep
`con` []
haskellType t :: Type
t@(TInterface n :: Name
n) = do
  API
api <- Type -> CodeGen API
getAPI Type
t
  Text
tname <- Name -> CodeGen Text
qualifiedAPI 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 _) -> "[]" Text -> [TypeRep] -> TypeRep
`con` [Text
tname Text -> [TypeRep] -> TypeRep
`con` []]
             _ -> 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
/= -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 _) = do
  Maybe API
api <- Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
api of
    Just (APICallback _) -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    _ -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
typeIsCallback _ = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except 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 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
$ "GClosure" Text -> [TypeRep] -> TypeRep
`con` [Text -> TypeRep
con0 "()"]
isoHaskellType t :: Type
t@(TInterface n :: Name
n) = do
  Maybe API
api <- Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
api of
    Just (APICallback cb :: Callback
cb) -> do
        Text
tname <- Name -> CodeGen Text
qualifiedAPI 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` [])
    _ -> Type -> CodeGen TypeRep
haskellType Type
t
isoHaskellType t :: 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 TBoolean  = "CInt" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType TUTF8     = "CString" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType TFileName = "CString" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType TUniChar  = "CInt" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType TFloat    = "CFloat" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType TDouble   = "CDouble" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType TGType    = "CGType" Text -> [TypeRep] -> TypeRep
`con` []
foreignBasicType t :: 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 t :: 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 zt :: Bool
zt _ _ t :: Type
t) = do
  Maybe API
api <- Type -> CodeGen (Maybe API)
findAPI Type
t
  let size :: Int
size = case Maybe API
api of
               Just (APIStruct s :: Struct
s) -> Struct -> Int
structSize Struct
s
               Just (APIUnion u :: Union
u) -> Union -> Int
unionSize Union
u
               _ -> 0
  if Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 a :: 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 ("GArray" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner])
foreignType (TPtrArray a :: 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 ("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 ("GByteArray" Text -> [TypeRep] -> TypeRep
`con` [])
foreignType (TGList a :: 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 ("GList" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner])
foreignType (TGSList a :: 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 ("GSList" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
inner])
foreignType (TGHash a :: Type
a b :: 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 ("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 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 ("GClosure" Text -> [TypeRep] -> TypeRep
`con` [Text -> TypeRep
con0 "()"])
foreignType t :: Type
t@(TGClosure (Just _)) = 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 (TInterface (Name "GObject" "Value")) =
  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 (TypeRep -> TypeRep) -> TypeRep -> TypeRep
forall a b. (a -> b) -> a -> b
$ "GValue" Text -> [TypeRep] -> TypeRep
`con` []
foreignType t :: Type
t@(TInterface n :: Name
n) = do
  API
api <- Type -> CodeGen API
getAPI Type
t
  let enumIsSigned :: Enumeration -> Bool
enumIsSigned e :: 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
< 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 e :: Enumeration
e = if Enumeration -> Bool
enumIsSigned Enumeration
e
                       then "CInt"
                       else "CUInt"
  case API
api of
    APIEnum e :: 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 e :: 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 _ -> do
      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` [])
    _ -> do
      Text
tname <- Name -> CodeGen Text
qualifiedAPI 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 t :: Type
t = do
  Maybe API
a <- Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
a of
    Nothing -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    (Just (APIEnum _)) -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    (Just (APIFlags _)) -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    _ -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Information on how to allocate a type.
data TypeAllocInfo = TypeAllocInfo {
      TypeAllocInfo -> Bool
typeAllocInfoIsBoxed :: Bool
    , TypeAllocInfo -> Int
typeAllocInfoSize    :: Int -- ^ In bytes.
    }

-- | Information on how to allocate the given type, if known.
typeAllocInfo :: Type -> CodeGen (Maybe TypeAllocInfo)
typeAllocInfo :: Type -> CodeGen (Maybe TypeAllocInfo)
typeAllocInfo t :: Type
t = do
  Maybe API
api <- Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
api of
    Just (APIStruct s :: Struct
s) -> case Struct -> Int
structSize Struct
s of
                            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
                            n :: Int
n -> let info :: TypeAllocInfo
info = TypeAllocInfo :: Bool -> Int -> TypeAllocInfo
TypeAllocInfo {
                                              typeAllocInfoIsBoxed :: Bool
typeAllocInfoIsBoxed = Struct -> Bool
structIsBoxed Struct
s
                                            , typeAllocInfoSize :: Int
typeAllocInfoSize = Int
n
                                            }
                                 in Maybe TypeAllocInfo
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Maybe TypeAllocInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeAllocInfo -> Maybe TypeAllocInfo
forall a. a -> Maybe a
Just TypeAllocInfo
info)
    _ -> 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 TError = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged TVariant = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged TParamSpec = Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isManaged (TGClosure _) = 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 _) = do
  Maybe API
a <- Type -> CodeGen (Maybe API)
findAPI Type
t
  case Maybe API
a of
    Just (APIObject _)    -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just (APIInterface _) -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just (APIStruct _)    -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just (APIUnion _)     -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    _                     -> Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isManaged _ = 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 t :: 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 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 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 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 t :: Type
t = do
  TypeRep
ft <- Type -> CodeGen TypeRep
foreignType Type
t
  case TypeRep -> Text
typeConName TypeRep
ft of
    "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)
    "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)
    _        -> 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 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 _) = 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 _) = 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 t :: Type
t = do
  Maybe FFIPtrType
pt <- Type -> CodeGen (Maybe FFIPtrType)
typePtrType Type
t
  case Maybe FFIPtrType
pt of
    Just 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 "SP.convertIfNonNull")
    Just 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 "SP.convertFunPtrIfNonNull")
    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 t :: Type
t = do
  Maybe FFIPtrType
pt <- Type -> CodeGen (Maybe FFIPtrType)
typePtrType Type
t
  case Maybe FFIPtrType
pt of
    Just 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 "FP.nullPtr")
    Just 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 "FP.nullFunPtr")
    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

-- | 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 t :: 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 _ _ _ (TBasicType TUInt8)) _ = Maybe (Type, Text)
forall a. Maybe a
Nothing
elementTypeAndMap (TCArray True _ _ t :: Type
t) _ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, "mapZeroTerminatedCArray")
elementTypeAndMap (TCArray False (-1) _ t :: Type
t) len :: 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
$ "mapCArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
len)
elementTypeAndMap (TCArray False fixed :: Int
fixed _ t :: Type
t) _ =
    (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
$ "mapCArrayWithLength " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
fixed)
elementTypeAndMap (TGArray t :: Type
t) _ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, "mapGArray")
elementTypeAndMap (TPtrArray t :: Type
t) _ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, "mapPtrArray")
elementTypeAndMap (TGList t :: Type
t) _ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, "mapGList")
elementTypeAndMap (TGSList t :: Type
t) _ = (Type, Text) -> Maybe (Type, Text)
forall a. a -> Maybe a
Just (Type
t, "mapGSList")
-- GHashTable is treated separately, see Transfer.hs
elementTypeAndMap _ _ = Maybe (Type, Text)
forall a. Maybe a
Nothing

-- Return just the element type.
elementType :: Type -> Maybe Type
elementType :: Type -> Maybe Type
elementType t :: 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 t :: Type
t len :: 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