module Graphics.QML.Internal.Marshal where
import Control.Monad.Trans.Maybe
import Data.Maybe
import Data.Tagged
import Foreign.Ptr
import System.IO
newtype TypeName = TypeName {
typeName :: String
}
class MarshalIn a where
mIn :: InMarshaller a
type ErrIO a = MaybeT IO a
runErrIO :: ErrIO a -> IO ()
runErrIO m = do
r <- runMaybeT m
if isNothing r
then hPutStrLn stderr "Warning: Marshalling error."
else return ()
errIO :: IO a -> ErrIO a
errIO = MaybeT . fmap Just
data InMarshaller a = InMarshaller {
mInFuncFld :: Ptr () -> ErrIO a,
mIOTypeFld :: Tagged a TypeName
}
mInFunc :: (MarshalIn a) => Ptr () -> ErrIO a
mInFunc = mInFuncFld mIn
mIOType :: (MarshalIn a) => Tagged a TypeName
mIOType = mIOTypeFld mIn
class (MarshalIn a) => MarshalOut a where
mOutFunc :: Ptr () -> a -> IO ()
mOutAlloc :: a -> (Ptr () -> IO b) -> IO b
instance MarshalOut () where
mOutFunc _ _ = return ()
mOutAlloc _ f = f nullPtr
instance MarshalIn () where
mIn = InMarshaller {
mInFuncFld = \_ -> return (),
mIOTypeFld = Tagged $ TypeName ""
}