{-# LANGUAGE
    ScopedTypeVariables,
    TypeFamilies,
    FlexibleInstances
  #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Type classs and instances for marshalling values between Haskell and QML.
module Graphics.QML.Marshal (
  -- * Marshalling Type-class
  Marshal (
    type MarshalMode,
    marshaller),
  ModeBidi,
  ModeFrom,
  ModeTo,
  ModeRetVoid,
  ModeObjBidi,
  ModeObjFrom,
  ModeObjTo,
  Yes,
  CanGetFrom,
  ICanGetFrom,
  CanPassTo,
  ICanPassTo,
  CanReturnTo,
  ICanReturnTo,
  IsObjType,
  IIsObjType,
  GetObjType,
  IGetObjType,
  Marshaller,

  -- * Data Types
  Ignored (
    Ignored),

  -- * Custom Marshallers
  bidiMarshallerIO,
  bidiMarshaller,
  fromMarshallerIO,
  fromMarshaller,
  toMarshallerIO,
  toMarshaller
) where

import Graphics.QML.Internal.BindPrim
import Graphics.QML.Internal.Marshal
import Graphics.QML.Internal.Types

import Control.Monad
import Control.Monad.Trans.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BSU
import Data.Tagged
import Data.Int
import Data.Text (Text)
import qualified Data.Text.Encoding as TE
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr
import Foreign.Storable

--
-- Boolean built-in type
--

instance Marshal Bool where
    type MarshalMode Bool c d = ModeBidi c
    marshaller :: MarshallerFor Bool
marshaller = Marshaller {
        mTypeCVal_ :: MTypeCValFunc Bool
mTypeCVal_ = TypeId -> MTypeCValFunc Bool
forall {k} (s :: k) b. b -> Tagged s b
Tagged TypeId
tyJSValue,
        mFromCVal_ :: MFromCValFunc Bool
mFromCVal_ = MFromCValFunc Bool
forall t. Marshal t => MFromCValFunc t
jvalFromCVal,
        mToCVal_ :: MToCValFunc Bool
mToCVal_ = MToCValFunc Bool
forall t. Marshal t => MToCValFunc t
jvalToCVal,
        mWithCVal_ :: MWithCValFunc Bool
mWithCVal_ = Bool -> (Ptr () -> IO b) -> IO b
MWithCValFunc Bool
forall t. Marshal t => MWithCValFunc t
jvalWithCVal,
        mFromJVal_ :: MFromJValFunc Bool
mFromJVal_ = \Strength
s HsQMLJValHandle
ptr ->
            IO (Maybe Bool) -> MaybeT IO Bool
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Bool) -> MaybeT IO Bool)
-> IO (Maybe Bool) -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ Strength
-> (HsQMLJValHandle -> IO Bool)
-> (HsQMLJValHandle -> IO Bool)
-> HsQMLJValHandle
-> IO (Maybe Bool)
forall a.
Strength
-> (HsQMLJValHandle -> IO Bool)
-> (HsQMLJValHandle -> IO a)
-> HsQMLJValHandle
-> IO (Maybe a)
fromJVal Strength
s HsQMLJValHandle -> IO Bool
hsqmlIsJvalBool HsQMLJValHandle -> IO Bool
hsqmlGetJvalBool HsQMLJValHandle
ptr,
        mWithJVal_ :: MWithJValFunc Bool
mWithJVal_ = \Bool
bool HsQMLJValHandle -> IO b
f ->
            (HsQMLJValHandle -> Bool -> IO ())
-> Bool -> (HsQMLJValHandle -> IO b) -> IO b
forall a b.
(HsQMLJValHandle -> a -> IO ())
-> a -> (HsQMLJValHandle -> IO b) -> IO b
withJVal HsQMLJValHandle -> Bool -> IO ()
hsqmlInitJvalBool Bool
bool HsQMLJValHandle -> IO b
f,
        mFromHndl_ :: MFromHndlFunc Bool
mFromHndl_ = MFromHndlFunc Bool
forall t. MFromHndlFunc t
unimplFromHndl,
        mToHndl_ :: MToHndlFunc Bool
mToHndl_ = MToHndlFunc Bool
forall t. MToHndlFunc t
unimplToHndl}

--
-- Int32/int built-in type
--

instance Marshal Int32 where
    type MarshalMode Int32 c d = ModeBidi c
    marshaller :: MarshallerFor Int32
marshaller = Marshaller {
        mTypeCVal_ :: MTypeCValFunc Int32
mTypeCVal_ = TypeId -> MTypeCValFunc Int32
forall {k} (s :: k) b. b -> Tagged s b
Tagged TypeId
tyInt,
        mFromCVal_ :: MFromCValFunc Int32
mFromCVal_ = \Ptr ()
ptr ->
            IO Int32 -> ErrIO Int32
forall a. IO a -> ErrIO a
errIO (IO Int32 -> ErrIO Int32) -> IO Int32 -> ErrIO Int32
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr :: Ptr CInt) IO CInt -> (CInt -> IO Int32) -> IO Int32
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> IO Int32) -> (CInt -> Int32) -> CInt -> IO Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral,
        mToCVal_ :: MToCValFunc Int32
mToCVal_ = \Int32
int Ptr ()
ptr ->
            Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr () -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr :: Ptr CInt) (Int32 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
int),
        mWithCVal_ :: MWithCValFunc Int32
mWithCVal_ = \Int32
int Ptr () -> IO b
f ->
            (Ptr CInt -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO b) -> IO b) -> (Ptr CInt -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \(Ptr CInt
ptr :: Ptr CInt) ->
                MToCValFunc Int32
forall t. Marshal t => MToCValFunc t
mToCVal Int32
int (Ptr CInt -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr) IO () -> IO b -> IO b
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr () -> IO b
f (Ptr CInt -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr),
        mFromJVal_ :: MFromJValFunc Int32
mFromJVal_ = \Strength
s HsQMLJValHandle
ptr ->
            IO (Maybe Int32) -> ErrIO Int32
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Int32) -> ErrIO Int32)
-> IO (Maybe Int32) -> ErrIO Int32
forall a b. (a -> b) -> a -> b
$ Strength
-> (HsQMLJValHandle -> IO Bool)
-> (HsQMLJValHandle -> IO Int32)
-> HsQMLJValHandle
-> IO (Maybe Int32)
forall a.
Strength
-> (HsQMLJValHandle -> IO Bool)
-> (HsQMLJValHandle -> IO a)
-> HsQMLJValHandle
-> IO (Maybe a)
fromJVal Strength
s HsQMLJValHandle -> IO Bool
hsqmlIsJvalNumber (
                (CInt -> Int32) -> IO CInt -> IO Int32
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int32)
-> (HsQMLJValHandle -> IO CInt) -> HsQMLJValHandle -> IO Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsQMLJValHandle -> IO CInt
hsqmlGetJvalInt) HsQMLJValHandle
ptr,
        mWithJVal_ :: MWithJValFunc Int32
mWithJVal_ = \Int32
int HsQMLJValHandle -> IO b
f ->
            (HsQMLJValHandle -> CInt -> IO ())
-> CInt -> (HsQMLJValHandle -> IO b) -> IO b
forall a b.
(HsQMLJValHandle -> a -> IO ())
-> a -> (HsQMLJValHandle -> IO b) -> IO b
withJVal HsQMLJValHandle -> CInt -> IO ()
hsqmlInitJvalInt (Int32 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
int) HsQMLJValHandle -> IO b
f,
        mFromHndl_ :: MFromHndlFunc Int32
mFromHndl_ = MFromHndlFunc Int32
forall t. MFromHndlFunc t
unimplFromHndl,
        mToHndl_ :: MToHndlFunc Int32
mToHndl_ = MToHndlFunc Int32
forall t. MToHndlFunc t
unimplToHndl}

instance Marshal Int where
    type MarshalMode Int c d = ModeBidi c
    marshaller :: MarshallerFor Int
marshaller = Marshaller {
        mTypeCVal_ :: MTypeCValFunc Int
mTypeCVal_ = TypeId -> MTypeCValFunc Int
forall {k} (s :: k) b. b -> Tagged s b
Tagged TypeId
tyInt,
        mFromCVal_ :: MFromCValFunc Int
mFromCVal_ = (Int32 -> Int) -> ErrIO Int32 -> MaybeT IO Int
forall a b. (a -> b) -> MaybeT IO a -> MaybeT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int32 -> Int) (ErrIO Int32 -> MaybeT IO Int)
-> MFromCValFunc Int32 -> MFromCValFunc Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MFromCValFunc Int32
forall t. Marshal t => MFromCValFunc t
mFromCVal,
        mToCVal_ :: MToCValFunc Int
mToCVal_ = \Int
int Ptr ()
ptr -> MToCValFunc Int32
forall t. Marshal t => MToCValFunc t
mToCVal (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Int32) Ptr ()
ptr,
        mWithCVal_ :: MWithCValFunc Int
mWithCVal_ = \Int
int Ptr () -> IO b
f -> Int32 -> (Ptr () -> IO b) -> IO b
MWithCValFunc Int32
forall t. Marshal t => MWithCValFunc t
mWithCVal (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Int32) Ptr () -> IO b
f,
        mFromJVal_ :: MFromJValFunc Int
mFromJVal_ = \Strength
s -> (Int32 -> Int) -> ErrIO Int32 -> MaybeT IO Int
forall a b. (a -> b) -> MaybeT IO a -> MaybeT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int32 -> Int) (ErrIO Int32 -> MaybeT IO Int)
-> (HsQMLJValHandle -> ErrIO Int32)
-> HsQMLJValHandle
-> MaybeT IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MFromJValFunc Int32
forall t. Marshal t => MFromJValFunc t
mFromJVal Strength
s,
        mWithJVal_ :: MWithJValFunc Int
mWithJVal_ = \Int
int HsQMLJValHandle -> IO b
f -> Int32 -> (HsQMLJValHandle -> IO b) -> IO b
MWithJValFunc Int32
forall t. Marshal t => MWithJValFunc t
mWithJVal (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Int32) HsQMLJValHandle -> IO b
f,
        mFromHndl_ :: MFromHndlFunc Int
mFromHndl_ = MFromHndlFunc Int
forall t. MFromHndlFunc t
unimplFromHndl,
        mToHndl_ :: MToHndlFunc Int
mToHndl_ = MToHndlFunc Int
forall t. MToHndlFunc t
unimplToHndl}

--
-- Double/double built-in type
--

instance Marshal Double where
    type MarshalMode Double c d = ModeBidi c
    marshaller :: MarshallerFor Double
marshaller = Marshaller {
        mTypeCVal_ :: MTypeCValFunc Double
mTypeCVal_ = TypeId -> MTypeCValFunc Double
forall {k} (s :: k) b. b -> Tagged s b
Tagged TypeId
tyDouble,
        mFromCVal_ :: MFromCValFunc Double
mFromCVal_ = \Ptr ()
ptr ->
            IO Double -> ErrIO Double
forall a. IO a -> ErrIO a
errIO (IO Double -> ErrIO Double) -> IO Double -> ErrIO Double
forall a b. (a -> b) -> a -> b
$ Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr CDouble
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr :: Ptr CDouble) IO CDouble -> (CDouble -> IO Double) -> IO Double
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> IO Double)
-> (CDouble -> Double) -> CDouble -> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac,
        mToCVal_ :: MToCValFunc Double
mToCVal_ = \Double
num Ptr ()
ptr ->
            Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr () -> Ptr CDouble
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr :: Ptr CDouble) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
num),
        mWithCVal_ :: MWithCValFunc Double
mWithCVal_ = \Double
num Ptr () -> IO b
f ->
            (Ptr CDouble -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO b) -> IO b) -> (Ptr CDouble -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \(Ptr CDouble
ptr :: Ptr CDouble) ->
                MToCValFunc Double
forall t. Marshal t => MToCValFunc t
mToCVal Double
num (Ptr CDouble -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CDouble
ptr) IO () -> IO b -> IO b
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr () -> IO b
f (Ptr CDouble -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CDouble
ptr),
        mFromJVal_ :: MFromJValFunc Double
mFromJVal_ = \Strength
s HsQMLJValHandle
ptr ->
            IO (Maybe Double) -> ErrIO Double
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Double) -> ErrIO Double)
-> IO (Maybe Double) -> ErrIO Double
forall a b. (a -> b) -> a -> b
$ Strength
-> (HsQMLJValHandle -> IO Bool)
-> (HsQMLJValHandle -> IO Double)
-> HsQMLJValHandle
-> IO (Maybe Double)
forall a.
Strength
-> (HsQMLJValHandle -> IO Bool)
-> (HsQMLJValHandle -> IO a)
-> HsQMLJValHandle
-> IO (Maybe a)
fromJVal Strength
s HsQMLJValHandle -> IO Bool
hsqmlIsJvalNumber (
                (CDouble -> Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double)
-> (HsQMLJValHandle -> IO CDouble) -> HsQMLJValHandle -> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsQMLJValHandle -> IO CDouble
hsqmlGetJvalDouble) HsQMLJValHandle
ptr,
        mWithJVal_ :: MWithJValFunc Double
mWithJVal_ = \Double
num HsQMLJValHandle -> IO b
f ->
            (HsQMLJValHandle -> CDouble -> IO ())
-> CDouble -> (HsQMLJValHandle -> IO b) -> IO b
forall a b.
(HsQMLJValHandle -> a -> IO ())
-> a -> (HsQMLJValHandle -> IO b) -> IO b
withJVal HsQMLJValHandle -> CDouble -> IO ()
hsqmlInitJvalDouble (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
num) HsQMLJValHandle -> IO b
f,
        mFromHndl_ :: MFromHndlFunc Double
mFromHndl_ = MFromHndlFunc Double
forall t. MFromHndlFunc t
unimplFromHndl,
        mToHndl_ :: MToHndlFunc Double
mToHndl_ = MToHndlFunc Double
forall t. MToHndlFunc t
unimplToHndl}

--
-- Text/QString built-in type
--


instance Marshal Text where
    type MarshalMode Text c d = ModeBidi c
    marshaller :: MarshallerFor Text
marshaller = Marshaller {
        mTypeCVal_ :: MTypeCValFunc Text
mTypeCVal_ = TypeId -> MTypeCValFunc Text
forall {k} (s :: k) b. b -> Tagged s b
Tagged TypeId
tyString,
        mFromCVal_ :: MFromCValFunc Text
mFromCVal_ = \Ptr ()
ptr -> IO Text -> ErrIO Text
forall a. IO a -> ErrIO a
errIO (IO Text -> ErrIO Text) -> IO Text -> ErrIO Text
forall a b. (a -> b) -> a -> b
$ do
            (Ptr CUShort, Int)
pair <- (Ptr (Ptr CUShort) -> IO (Ptr CUShort, Int))
-> IO (Ptr CUShort, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr (Ptr CUShort)
bufPtr -> do
                Int
len <- HsQMLStringHandle -> Ptr (Ptr CUShort) -> IO Int
hsqmlReadString (Ptr HsQMLStringHandle -> HsQMLStringHandle
HsQMLStringHandle (Ptr HsQMLStringHandle -> HsQMLStringHandle)
-> Ptr HsQMLStringHandle -> HsQMLStringHandle
forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr HsQMLStringHandle
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr) Ptr (Ptr CUShort)
bufPtr
                Ptr CUShort
buf <- Ptr (Ptr CUShort) -> IO (Ptr CUShort)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CUShort)
bufPtr
                (Ptr CUShort, Int) -> IO (Ptr CUShort, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CUShort
buf, Int
len))
            let (Ptr CUShort
buf, Int
len) = (Ptr CUShort, Int)
pair
            ByteString
bs <- CStringLen -> IO ByteString
BS.packCStringLen (Ptr CUShort -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CUShort
buf, Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
            Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf16LE ByteString
bs,
        mToCVal_ :: MToCValFunc Text
mToCVal_ = \Text
txt Ptr ()
ptr -> do
            let bs :: ByteString
bs = Text -> ByteString
TE.encodeUtf16LE Text
txt
                ucs2Length :: Int
ucs2Length = ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            Ptr CUShort
array <- Int -> HsQMLStringHandle -> IO (Ptr CUShort)
hsqmlWriteString Int
ucs2Length (Ptr HsQMLStringHandle -> HsQMLStringHandle
HsQMLStringHandle (Ptr HsQMLStringHandle -> HsQMLStringHandle)
-> Ptr HsQMLStringHandle -> HsQMLStringHandle
forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr HsQMLStringHandle
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr)
            ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs (\(Ptr CChar
bsp, Int
bslen) -> Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr CUShort -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CUShort
array) Ptr CChar
bsp Int
bslen),
        mWithCVal_ :: MWithCValFunc Text
mWithCVal_ = \Text
txt Ptr () -> IO b
f ->
            (HsQMLStringHandle -> IO b) -> IO b
forall b. (HsQMLStringHandle -> IO b) -> IO b
withStrHndl ((HsQMLStringHandle -> IO b) -> IO b)
-> (HsQMLStringHandle -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \(HsQMLStringHandle Ptr HsQMLStringHandle
ptr) -> do
                MToCValFunc Text
forall t. Marshal t => MToCValFunc t
mToCVal Text
txt (Ptr () -> IO ()) -> Ptr () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr HsQMLStringHandle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr HsQMLStringHandle
ptr
                Ptr () -> IO b
f (Ptr () -> IO b) -> Ptr () -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr HsQMLStringHandle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr HsQMLStringHandle
ptr,
        mFromJVal_ :: MFromJValFunc Text
mFromJVal_ = \Strength
s HsQMLJValHandle
jval ->
            IO (Maybe Text) -> ErrIO Text
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Text) -> ErrIO Text) -> IO (Maybe Text) -> ErrIO Text
forall a b. (a -> b) -> a -> b
$ (HsQMLStringHandle -> IO (Maybe Text)) -> IO (Maybe Text)
forall b. (HsQMLStringHandle -> IO b) -> IO b
withStrHndl ((HsQMLStringHandle -> IO (Maybe Text)) -> IO (Maybe Text))
-> (HsQMLStringHandle -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \HsQMLStringHandle
sHndl -> ErrIO Text -> IO (Maybe Text)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (ErrIO Text -> IO (Maybe Text)) -> ErrIO Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
                IO (Maybe ()) -> MaybeT IO ()
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ()) -> MaybeT IO ()) -> IO (Maybe ()) -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Strength
-> (HsQMLJValHandle -> IO Bool)
-> (HsQMLJValHandle -> IO ())
-> HsQMLJValHandle
-> IO (Maybe ())
forall a.
Strength
-> (HsQMLJValHandle -> IO Bool)
-> (HsQMLJValHandle -> IO a)
-> HsQMLJValHandle
-> IO (Maybe a)
fromJVal Strength
s HsQMLJValHandle -> IO Bool
hsqmlIsJvalString (
                    (HsQMLJValHandle -> HsQMLStringHandle -> IO ())
-> HsQMLStringHandle -> HsQMLJValHandle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip HsQMLJValHandle -> HsQMLStringHandle -> IO ()
hsqmlGetJvalString HsQMLStringHandle
sHndl) HsQMLJValHandle
jval
                let (HsQMLStringHandle Ptr HsQMLStringHandle
ptr) = HsQMLStringHandle
sHndl
                MFromCValFunc Text
forall t. Marshal t => MFromCValFunc t
mFromCVal MFromCValFunc Text -> MFromCValFunc Text
forall a b. (a -> b) -> a -> b
$ Ptr HsQMLStringHandle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr HsQMLStringHandle
ptr,
        mWithJVal_ :: MWithJValFunc Text
mWithJVal_ = \Text
txt HsQMLJValHandle -> IO b
f ->
            Text -> (Ptr () -> IO b) -> IO b
MWithCValFunc Text
forall t. Marshal t => MWithCValFunc t
mWithCVal Text
txt ((Ptr () -> IO b) -> IO b) -> (Ptr () -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr -> (HsQMLJValHandle -> HsQMLStringHandle -> IO ())
-> HsQMLStringHandle -> (HsQMLJValHandle -> IO b) -> IO b
forall a b.
(HsQMLJValHandle -> a -> IO ())
-> a -> (HsQMLJValHandle -> IO b) -> IO b
withJVal HsQMLJValHandle -> HsQMLStringHandle -> IO ()
hsqmlInitJvalString (
                Ptr HsQMLStringHandle -> HsQMLStringHandle
HsQMLStringHandle (Ptr HsQMLStringHandle -> HsQMLStringHandle)
-> Ptr HsQMLStringHandle -> HsQMLStringHandle
forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr HsQMLStringHandle
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr) HsQMLJValHandle -> IO b
f,
        mFromHndl_ :: MFromHndlFunc Text
mFromHndl_ = MFromHndlFunc Text
forall t. MFromHndlFunc t
unimplFromHndl,
        mToHndl_ :: MToHndlFunc Text
mToHndl_ = MToHndlFunc Text
forall t. MToHndlFunc t
unimplToHndl}

--
-- Maybe
--

instance (Marshal a) => Marshal (Maybe a) where
    type MarshalMode (Maybe a) ICanGetFrom d = MarshalMode a ICanGetFrom d
    type MarshalMode (Maybe a) ICanPassTo d = MarshalMode a ICanPassTo d
    type MarshalMode (Maybe a) ICanReturnTo d = MarshalMode a ICanReturnTo d
    type MarshalMode (Maybe a) IIsObjType d = No
    type MarshalMode (Maybe a) IGetObjType d = No
    marshaller :: MarshallerFor (Maybe a)
marshaller = Marshaller {
        mTypeCVal_ :: MTypeCValFunc (Maybe a)
mTypeCVal_ = TypeId -> MTypeCValFunc (Maybe a)
forall {k} (s :: k) b. b -> Tagged s b
Tagged TypeId
tyJSValue,
        mFromCVal_ :: MFromCValFunc (Maybe a)
mFromCVal_ = MFromCValFunc (Maybe a)
forall t. Marshal t => MFromCValFunc t
jvalFromCVal,
        mToCVal_ :: MToCValFunc (Maybe a)
mToCVal_ = MToCValFunc (Maybe a)
forall t. Marshal t => MToCValFunc t
jvalToCVal,
        mWithCVal_ :: MWithCValFunc (Maybe a)
mWithCVal_ = Maybe a -> (Ptr () -> IO b) -> IO b
MWithCValFunc (Maybe a)
forall t. Marshal t => MWithCValFunc t
jvalWithCVal,
        mFromJVal_ :: MFromJValFunc (Maybe a)
mFromJVal_ = \Strength
_ HsQMLJValHandle
jval -> IO (Maybe a) -> ErrIO (Maybe a)
forall a. IO a -> ErrIO a
errIO (IO (Maybe a) -> ErrIO (Maybe a))
-> IO (Maybe a) -> ErrIO (Maybe a)
forall a b. (a -> b) -> a -> b
$ MaybeT IO a -> IO (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO a -> IO (Maybe a)) -> MaybeT IO a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ MFromJValFunc a
forall t. Marshal t => MFromJValFunc t
mFromJVal Strength
Weak HsQMLJValHandle
jval,
        mWithJVal_ :: MWithJValFunc (Maybe a)
mWithJVal_ = \Maybe a
val HsQMLJValHandle -> IO b
f ->
            case Maybe a
val of
                Just a
val' -> a -> (HsQMLJValHandle -> IO b) -> IO b
MWithJValFunc a
forall t. Marshal t => MWithJValFunc t
mWithJVal a
val' HsQMLJValHandle -> IO b
f
                Maybe a
Nothing   -> (HsQMLJValHandle -> Bool -> IO ())
-> Bool -> (HsQMLJValHandle -> IO b) -> IO b
forall a b.
(HsQMLJValHandle -> a -> IO ())
-> a -> (HsQMLJValHandle -> IO b) -> IO b
withJVal HsQMLJValHandle -> Bool -> IO ()
hsqmlInitJvalNull Bool
False HsQMLJValHandle -> IO b
f,
        mFromHndl_ :: MFromHndlFunc (Maybe a)
mFromHndl_ = MFromHndlFunc (Maybe a)
forall t. MFromHndlFunc t
unimplFromHndl,
        mToHndl_ :: MToHndlFunc (Maybe a)
mToHndl_ = MToHndlFunc (Maybe a)
forall t. MToHndlFunc t
unimplToHndl}

--
-- List
--

instance (Marshal a) => Marshal [a] where
    type MarshalMode [a] ICanGetFrom d = MarshalMode a ICanGetFrom d
    type MarshalMode [a] ICanPassTo d = MarshalMode a ICanPassTo d
    type MarshalMode [a] ICanReturnTo d = MarshalMode a ICanReturnTo d
    type MarshalMode [a] IIsObjType d = No
    type MarshalMode [a] IGetObjType d = No
    marshaller :: MarshallerFor [a]
marshaller = Marshaller {
        mTypeCVal_ :: MTypeCValFunc [a]
mTypeCVal_ = TypeId -> MTypeCValFunc [a]
forall {k} (s :: k) b. b -> Tagged s b
Tagged TypeId
tyJSValue,
        mFromCVal_ :: MFromCValFunc [a]
mFromCVal_ = MFromCValFunc [a]
forall t. Marshal t => MFromCValFunc t
jvalFromCVal,
        mToCVal_ :: MToCValFunc [a]
mToCVal_ = MToCValFunc [a]
forall t. Marshal t => MToCValFunc t
jvalToCVal,
        mWithCVal_ :: MWithCValFunc [a]
mWithCVal_ = [a] -> (Ptr () -> IO b) -> IO b
MWithCValFunc [a]
forall t. Marshal t => MWithCValFunc t
jvalWithCVal,
        mFromJVal_ :: MFromJValFunc [a]
mFromJVal_ = \Strength
s HsQMLJValHandle
jval -> IO (Maybe [a]) -> MaybeT IO [a]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe [a]) -> MaybeT IO [a])
-> IO (Maybe [a]) -> MaybeT IO [a]
forall a b. (a -> b) -> a -> b
$ do
            Int
len <- HsQMLJValHandle -> IO Int
hsqmlGetJvalArrayLength HsQMLJValHandle
jval
            (HsQMLJValHandle -> Bool -> IO ())
-> Bool -> (HsQMLJValHandle -> IO (Maybe [a])) -> IO (Maybe [a])
forall a b.
(HsQMLJValHandle -> a -> IO ())
-> a -> (HsQMLJValHandle -> IO b) -> IO b
withJVal HsQMLJValHandle -> Bool -> IO ()
hsqmlInitJvalNull Bool
True ((HsQMLJValHandle -> IO (Maybe [a])) -> IO (Maybe [a]))
-> (HsQMLJValHandle -> IO (Maybe [a])) -> IO (Maybe [a])
forall a b. (a -> b) -> a -> b
$ \HsQMLJValHandle
tmp ->
                MaybeT IO [a] -> IO (Maybe [a])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO [a] -> IO (Maybe [a]))
-> MaybeT IO [a] -> IO (Maybe [a])
forall a b. (a -> b) -> a -> b
$ [Int] -> (Int -> MaybeT IO a) -> MaybeT IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> MaybeT IO a) -> MaybeT IO [a])
-> (Int -> MaybeT IO a) -> MaybeT IO [a]
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
                    IO () -> MaybeT IO ()
forall a. IO a -> ErrIO a
errIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ HsQMLJValHandle -> Int -> HsQMLJValHandle -> IO ()
hsqmlJvalArrayGet HsQMLJValHandle
jval Int
i HsQMLJValHandle
tmp
                    MFromJValFunc a
forall t. Marshal t => MFromJValFunc t
mFromJVal Strength
s HsQMLJValHandle
tmp,
        mWithJVal_ :: MWithJValFunc [a]
mWithJVal_ = \[a]
vs HsQMLJValHandle -> IO b
f ->
            (HsQMLJValHandle -> Int -> IO ())
-> Int -> (HsQMLJValHandle -> IO b) -> IO b
forall a b.
(HsQMLJValHandle -> a -> IO ())
-> a -> (HsQMLJValHandle -> IO b) -> IO b
withJVal HsQMLJValHandle -> Int -> IO ()
hsqmlInitJvalArray ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs) ((HsQMLJValHandle -> IO b) -> IO b)
-> (HsQMLJValHandle -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \HsQMLJValHandle
jval -> do
                [(Int, a)] -> ((Int, a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [a]
vs) (((Int, a) -> IO ()) -> IO ()) -> ((Int, a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> a -> IO ()) -> (Int, a) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> a -> IO ()) -> (Int, a) -> IO ())
-> (Int -> a -> IO ()) -> (Int, a) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i a
val ->
                    a -> (HsQMLJValHandle -> IO ()) -> IO ()
MWithJValFunc a
forall t. Marshal t => MWithJValFunc t
mWithJVal a
val ((HsQMLJValHandle -> IO ()) -> IO ())
-> (HsQMLJValHandle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HsQMLJValHandle
jval' ->
                        HsQMLJValHandle -> Int -> HsQMLJValHandle -> IO ()
hsqmlJvalArraySet HsQMLJValHandle
jval Int
i HsQMLJValHandle
jval'
                HsQMLJValHandle -> IO b
f HsQMLJValHandle
jval,
        mFromHndl_ :: MFromHndlFunc [a]
mFromHndl_ = MFromHndlFunc [a]
forall t. MFromHndlFunc t
unimplFromHndl,
        mToHndl_ :: MToHndlFunc [a]
mToHndl_ = MToHndlFunc [a]
forall t. MToHndlFunc t
unimplToHndl}

--
-- Ignored
--

-- | Represents an argument whose value is ignored.

data Ignored = Ignored

instance Marshal Ignored where
    type MarshalMode Ignored c d = ModeFrom c
    marshaller :: MarshallerFor Ignored
marshaller = Marshaller {
        mTypeCVal_ :: MTypeCValFunc Ignored
mTypeCVal_ = TypeId -> MTypeCValFunc Ignored
forall {k} (s :: k) b. b -> Tagged s b
Tagged TypeId
tyJSValue,
        mFromCVal_ :: MFromCValFunc Ignored
mFromCVal_ = MFromCValFunc Ignored
forall t. Marshal t => MFromCValFunc t
jvalFromCVal,
        mToCVal_ :: MToCValFunc Ignored
mToCVal_ = MToCValFunc Ignored
forall t. MToCValFunc t
unimplToCVal,
        mWithCVal_ :: MWithCValFunc Ignored
mWithCVal_ = Ignored -> (Ptr () -> IO b) -> IO b
MWithCValFunc Ignored
forall t b. t -> (Ptr () -> IO b) -> IO b
unimplWithCVal,
        mFromJVal_ :: MFromJValFunc Ignored
mFromJVal_ = \Strength
_ HsQMLJValHandle
_ -> IO (Maybe Ignored) -> MaybeT IO Ignored
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Ignored) -> MaybeT IO Ignored)
-> (Maybe Ignored -> IO (Maybe Ignored))
-> Maybe Ignored
-> MaybeT IO Ignored
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Ignored -> IO (Maybe Ignored)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Ignored -> MaybeT IO Ignored)
-> Maybe Ignored -> MaybeT IO Ignored
forall a b. (a -> b) -> a -> b
$ Ignored -> Maybe Ignored
forall a. a -> Maybe a
Just Ignored
Ignored,
        mWithJVal_ :: MWithJValFunc Ignored
mWithJVal_ = Ignored -> (HsQMLJValHandle -> IO b) -> IO b
MWithJValFunc Ignored
forall t b. t -> (HsQMLJValHandle -> IO b) -> IO b
unimplWithJVal,
        mFromHndl_ :: MFromHndlFunc Ignored
mFromHndl_ = MFromHndlFunc Ignored
forall t. MFromHndlFunc t
unimplFromHndl,
        mToHndl_ :: MToHndlFunc Ignored
mToHndl_ = MToHndlFunc Ignored
forall t. MToHndlFunc t
unimplToHndl}

type BidiMarshaller a b = Marshaller b
    (MarshalMode a ICanGetFrom ())
    (MarshalMode a ICanPassTo ())
    (MarshalMode a ICanReturnTo ())
    (MarshalMode a IIsObjType ())
    (MarshalMode a IGetObjType ())

-- | Provides a bidirectional 'Marshaller' which allows you to define an
-- instance of 'Marshal' for your own type @b@ in terms of another marshallable
-- type @a@. Type @b@ should have a 'MarshalMode' of 'ModeObjBidi' or
-- 'ModeBidi' depending on whether @a@ was an object type or not.
bidiMarshallerIO ::
    forall a b. (Marshal a, CanGetFrom a ~ Yes, CanPassTo a ~ Yes) =>
    (a -> IO b) -> (b -> IO a) -> BidiMarshaller a b
bidiMarshallerIO :: forall a b.
(Marshal a, CanGetFrom a ~ Yes, CanPassTo a ~ Yes) =>
(a -> IO b) -> (b -> IO a) -> BidiMarshaller a b
bidiMarshallerIO a -> IO b
fromFn b -> IO a
toFn = Marshaller {
    mTypeCVal_ :: MTypeCValFunc b
mTypeCVal_ = Tagged a TypeId -> MTypeCValFunc b
forall {k1} {k2} (s :: k1) b (t :: k2). Tagged s b -> Tagged t b
retag (Tagged a TypeId
forall t. Marshal t => MTypeCValFunc t
mTypeCVal :: Tagged a TypeId),
    mFromCVal_ :: MFromCValFunc b
mFromCVal_ = \Ptr ()
ptr -> (IO b -> ErrIO b
forall a. IO a -> ErrIO a
errIO (IO b -> ErrIO b) -> (a -> IO b) -> a -> ErrIO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
fromFn) (a -> ErrIO b) -> MaybeT IO a -> ErrIO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MFromCValFunc a
forall t. Marshal t => MFromCValFunc t
mFromCVal Ptr ()
ptr,
    mToCVal_ :: MToCValFunc b
mToCVal_ = \b
val Ptr ()
ptr -> (a -> Ptr () -> IO ()) -> Ptr () -> a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Ptr () -> IO ()
forall t. Marshal t => MToCValFunc t
mToCVal Ptr ()
ptr (a -> IO ()) -> IO a -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO a
toFn b
val,
    mWithCVal_ :: MWithCValFunc b
mWithCVal_ = \b
val Ptr () -> IO b
f -> (a -> (Ptr () -> IO b) -> IO b) -> (Ptr () -> IO b) -> a -> IO b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> (Ptr () -> IO b) -> IO b
MWithCValFunc a
forall t. Marshal t => MWithCValFunc t
mWithCVal Ptr () -> IO b
f (a -> IO b) -> IO a -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO a
toFn b
val,
    mFromJVal_ :: MFromJValFunc b
mFromJVal_ = \Strength
s HsQMLJValHandle
ptr -> (IO b -> ErrIO b
forall a. IO a -> ErrIO a
errIO (IO b -> ErrIO b) -> (a -> IO b) -> a -> ErrIO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
fromFn) (a -> ErrIO b) -> MaybeT IO a -> ErrIO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MFromJValFunc a
forall t. Marshal t => MFromJValFunc t
mFromJVal Strength
s HsQMLJValHandle
ptr,
    mWithJVal_ :: MWithJValFunc b
mWithJVal_ = \b
val HsQMLJValHandle -> IO b
f -> (a -> (HsQMLJValHandle -> IO b) -> IO b)
-> (HsQMLJValHandle -> IO b) -> a -> IO b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> (HsQMLJValHandle -> IO b) -> IO b
MWithJValFunc a
forall t. Marshal t => MWithJValFunc t
mWithJVal HsQMLJValHandle -> IO b
f (a -> IO b) -> IO a -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO a
toFn b
val,
    mFromHndl_ :: MFromHndlFunc b
mFromHndl_ = \HsQMLObjectHandle
hndl -> a -> IO b
fromFn (a -> IO b) -> IO a -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MFromHndlFunc a
forall t. Marshal t => MFromHndlFunc t
mFromHndl HsQMLObjectHandle
hndl,
    mToHndl_ :: MToHndlFunc b
mToHndl_ = \b
val -> MToHndlFunc a
forall t. Marshal t => MToHndlFunc t
mToHndl MToHndlFunc a -> IO a -> IO HsQMLObjectHandle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO a
toFn b
val}

-- | Variant of 'bidiMarshallerIO' where the conversion functions between types
-- @a@ and @b@ do not live in the IO monad.
bidiMarshaller ::
    forall a b. (Marshal a, CanGetFrom a ~ Yes, CanPassTo a ~ Yes) =>
    (a -> b) -> (b -> a) -> BidiMarshaller a b
bidiMarshaller :: forall a b.
(Marshal a, CanGetFrom a ~ Yes, CanPassTo a ~ Yes) =>
(a -> b) -> (b -> a) -> BidiMarshaller a b
bidiMarshaller a -> b
fromFn b -> a
toFn =
    (a -> IO b)
-> (b -> IO a)
-> Marshaller
     b
     (CanGetFrom a)
     (CanPassTo a)
     (MarshalMode a ICanReturnTo ())
     (MarshalMode a IIsObjType ())
     (MarshalMode a IGetObjType ())
forall a b.
(Marshal a, CanGetFrom a ~ Yes, CanPassTo a ~ Yes) =>
(a -> IO b) -> (b -> IO a) -> BidiMarshaller a b
bidiMarshallerIO (b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> (a -> b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
fromFn) (a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (b -> a) -> b -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
toFn)

type FromMarshaller a b = Marshaller b
    (MarshalMode a ICanGetFrom ())
    No
    No
    (MarshalMode a IIsObjType ())
    (MarshalMode a IGetObjType ())

-- | Provides a "from" 'Marshaller' which allows you to define an instance of
-- 'Marshal' for your own type @b@ in terms of another marshallable type @a@.
-- Type @b@ should have a 'MarshalMode' of 'ModeObjFrom' or 'ModeFrom'
-- depending on whether @a@ was an object type or not.
fromMarshallerIO ::
    forall a b. (Marshal a, CanGetFrom a ~ Yes) =>
    (a -> IO b) -> FromMarshaller a b
fromMarshallerIO :: forall a b.
(Marshal a, CanGetFrom a ~ Yes) =>
(a -> IO b) -> FromMarshaller a b
fromMarshallerIO a -> IO b
fromFn = Marshaller {
    mTypeCVal_ :: MTypeCValFunc b
mTypeCVal_ = Tagged a TypeId -> MTypeCValFunc b
forall {k1} {k2} (s :: k1) b (t :: k2). Tagged s b -> Tagged t b
retag (Tagged a TypeId
forall t. Marshal t => MTypeCValFunc t
mTypeCVal :: Tagged a TypeId),
    mFromCVal_ :: MFromCValFunc b
mFromCVal_ = \Ptr ()
ptr -> (IO b -> ErrIO b
forall a. IO a -> ErrIO a
errIO (IO b -> ErrIO b) -> (a -> IO b) -> a -> ErrIO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
fromFn) (a -> ErrIO b) -> MaybeT IO a -> ErrIO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MFromCValFunc a
forall t. Marshal t => MFromCValFunc t
mFromCVal Ptr ()
ptr,
    mToCVal_ :: MToCValFunc b
mToCVal_ = MToCValFunc b
forall t. MToCValFunc t
unimplToCVal,
    mWithCVal_ :: MWithCValFunc b
mWithCVal_ = b -> (Ptr () -> IO b) -> IO b
MWithCValFunc b
forall t b. t -> (Ptr () -> IO b) -> IO b
unimplWithCVal,
    mFromJVal_ :: MFromJValFunc b
mFromJVal_ = \Strength
s HsQMLJValHandle
ptr -> (IO b -> ErrIO b
forall a. IO a -> ErrIO a
errIO (IO b -> ErrIO b) -> (a -> IO b) -> a -> ErrIO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
fromFn) (a -> ErrIO b) -> MaybeT IO a -> ErrIO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MFromJValFunc a
forall t. Marshal t => MFromJValFunc t
mFromJVal Strength
s HsQMLJValHandle
ptr,
    mWithJVal_ :: MWithJValFunc b
mWithJVal_ = b -> (HsQMLJValHandle -> IO b) -> IO b
MWithJValFunc b
forall t b. t -> (HsQMLJValHandle -> IO b) -> IO b
unimplWithJVal,
    mFromHndl_ :: MFromHndlFunc b
mFromHndl_ = \HsQMLObjectHandle
hndl -> a -> IO b
fromFn (a -> IO b) -> IO a -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MFromHndlFunc a
forall t. Marshal t => MFromHndlFunc t
mFromHndl HsQMLObjectHandle
hndl,
    mToHndl_ :: MToHndlFunc b
mToHndl_ = MToHndlFunc b
forall t. MToHndlFunc t
unimplToHndl}

-- | Variant of 'fromMarshallerIO' where the conversion function between types
-- @a@ and @b@ does not live in the IO monad.
fromMarshaller ::
    forall a b. (Marshal a, CanGetFrom a ~ Yes) =>
    (a -> b) -> FromMarshaller a b
fromMarshaller :: forall a b.
(Marshal a, CanGetFrom a ~ Yes) =>
(a -> b) -> FromMarshaller a b
fromMarshaller a -> b
fromFn = (a -> IO b)
-> Marshaller
     b
     (CanGetFrom a)
     No
     No
     (MarshalMode a IIsObjType ())
     (MarshalMode a IGetObjType ())
forall a b.
(Marshal a, CanGetFrom a ~ Yes) =>
(a -> IO b) -> FromMarshaller a b
fromMarshallerIO (b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> (a -> b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
fromFn)

type ToMarshaller a b = Marshaller b
    No
    (MarshalMode a ICanPassTo ())
    (MarshalMode a ICanReturnTo ())
    (MarshalMode a IIsObjType ())
    (MarshalMode a IGetObjType ())

-- | Provides a "to" 'Marshaller' which allows you to define an instance of
-- 'Marshal' for your own type @b@ in terms of another marshallable type @a@.
-- Type @b@ should have a 'MarshalMode' of 'ModeObjTo' or 'ModeTo'
-- depending on whether @a@ was an object type or not.
toMarshallerIO ::
    forall a b. (Marshal a, CanPassTo a ~ Yes) =>
    (b -> IO a) -> ToMarshaller a b
toMarshallerIO :: forall a b.
(Marshal a, CanPassTo a ~ Yes) =>
(b -> IO a) -> ToMarshaller a b
toMarshallerIO b -> IO a
toFn = Marshaller {
    mTypeCVal_ :: MTypeCValFunc b
mTypeCVal_ = Tagged a TypeId -> MTypeCValFunc b
forall {k1} {k2} (s :: k1) b (t :: k2). Tagged s b -> Tagged t b
retag (Tagged a TypeId
forall t. Marshal t => MTypeCValFunc t
mTypeCVal :: Tagged a TypeId),
    mFromCVal_ :: MFromCValFunc b
mFromCVal_ = MFromCValFunc b
forall t. MFromCValFunc t
unimplFromCVal,
    mToCVal_ :: MToCValFunc b
mToCVal_ = \b
val Ptr ()
ptr -> (a -> Ptr () -> IO ()) -> Ptr () -> a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Ptr () -> IO ()
forall t. Marshal t => MToCValFunc t
mToCVal Ptr ()
ptr (a -> IO ()) -> IO a -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO a
toFn b
val,
    mWithCVal_ :: MWithCValFunc b
mWithCVal_ = \b
val Ptr () -> IO b
f -> (a -> (Ptr () -> IO b) -> IO b) -> (Ptr () -> IO b) -> a -> IO b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> (Ptr () -> IO b) -> IO b
MWithCValFunc a
forall t. Marshal t => MWithCValFunc t
mWithCVal Ptr () -> IO b
f (a -> IO b) -> IO a -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO a
toFn b
val,
    mFromJVal_ :: MFromJValFunc b
mFromJVal_ = MFromJValFunc b
forall t. MFromJValFunc t
unimplFromJVal,
    mWithJVal_ :: MWithJValFunc b
mWithJVal_ = \b
val HsQMLJValHandle -> IO b
f -> (a -> (HsQMLJValHandle -> IO b) -> IO b)
-> (HsQMLJValHandle -> IO b) -> a -> IO b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> (HsQMLJValHandle -> IO b) -> IO b
MWithJValFunc a
forall t. Marshal t => MWithJValFunc t
mWithJVal HsQMLJValHandle -> IO b
f (a -> IO b) -> IO a -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO a
toFn b
val,
    mFromHndl_ :: MFromHndlFunc b
mFromHndl_ = MFromHndlFunc b
forall t. MFromHndlFunc t
unimplFromHndl,
    mToHndl_ :: MToHndlFunc b
mToHndl_ = \b
val -> MToHndlFunc a
forall t. Marshal t => MToHndlFunc t
mToHndl MToHndlFunc a -> IO a -> IO HsQMLObjectHandle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO a
toFn b
val}

-- | Variant of 'toMarshallerIO' where the conversion function between types
-- @a@ and @b@ does not live in the IO monad.
toMarshaller ::
    forall a b. (Marshal a, CanPassTo a ~ Yes) =>
    (b -> a) -> ToMarshaller a b
toMarshaller :: forall a b.
(Marshal a, CanPassTo a ~ Yes) =>
(b -> a) -> ToMarshaller a b
toMarshaller b -> a
toFn = (b -> IO a)
-> Marshaller
     b
     No
     (CanPassTo a)
     (MarshalMode a ICanReturnTo ())
     (MarshalMode a IIsObjType ())
     (MarshalMode a IGetObjType ())
forall a b.
(Marshal a, CanPassTo a ~ Yes) =>
(b -> IO a) -> ToMarshaller a b
toMarshallerIO (a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (b -> a) -> b -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
toFn)