-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Graphics/QML/Internal/BindCore.chs" #-}
{-# LANGUAGE
    ForeignFunctionInterface
  #-}
{-# OPTIONS_HADDOCK hide #-}

module Graphics.QML.Internal.BindCore where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Graphics.QML.Internal.BindPrim
{-# LINE 8 "src/Graphics/QML/Internal/BindCore.chs" #-}

import Graphics.QML.Internal.BindObj
{-# LINE 9 "src/Graphics/QML/Internal/BindCore.chs" #-}


import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Utils (fromBool, toBool)
import Foreign.Ptr





type HsFreeFunPtr = FunPtr (FunPtr (IO ()) -> IO ())
foreign import ccall "HsFFI.h &hs_free_fun_ptr"
  hsFreeFunPtr :: HsFreeFunPtr

type HsFreeStablePtr = FunPtr (Ptr () -> IO ())
foreign import ccall "HsFFI.h &hs_free_stable_ptr"
  hsFreeStablePtr :: HsFreeStablePtr

hsqmlInit_ :: (HsFreeFunPtr) -> (HsFreeStablePtr) -> IO ()
hsqmlInit_ :: HsFreeFunPtr -> HsFreeStablePtr -> IO ()
hsqmlInit_ HsFreeFunPtr
a1 HsFreeStablePtr
a2 =
  let {a1' :: HsFreeFunPtr
a1' = HsFreeFunPtr -> HsFreeFunPtr
forall a. a -> a
id HsFreeFunPtr
a1} in 
  let {a2' :: HsFreeStablePtr
a2' = HsFreeStablePtr -> HsFreeStablePtr
forall a. a -> a
id HsFreeStablePtr
a2} in 
  HsFreeFunPtr -> HsFreeStablePtr -> IO ()
hsqmlInit_'_ HsFreeFunPtr
a1' HsFreeStablePtr
a2' IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 31 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlInit :: IO ()
hsqmlInit = hsqmlInit_ hsFreeFunPtr hsFreeStablePtr

hsqmlSetArgs :: (Ptr HsQMLStringHandle) -> IO ((Bool))
hsqmlSetArgs :: Ptr HsQMLStringHandle -> IO Bool
hsqmlSetArgs Ptr HsQMLStringHandle
a1 =
  let {a1' :: Ptr HsQMLStringHandle
a1' = Ptr HsQMLStringHandle -> Ptr HsQMLStringHandle
forall a. a -> a
id Ptr HsQMLStringHandle
a1} in 
  Ptr HsQMLStringHandle -> IO CInt
hsqmlSetArgs'_ Ptr HsQMLStringHandle
a1' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Bool
res' = CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
res} in
  Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 38 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlGetArgsCount :: IO ((Int))
hsqmlGetArgsCount =
  hsqmlGetArgsCount'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 42 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlGetArgs :: (Ptr HsQMLStringHandle) -> IO ()
hsqmlGetArgs a1 =
  let {a1' = id a1} in 
  hsqmlGetArgs'_ a1' >>
  return ()

{-# LINE 46 "src/Graphics/QML/Internal/BindCore.chs" #-}


data HsQMLGlobalFlag = HsqmlGflagShareOpenglContexts
                     | HsqmlGflagEnableQmlDebug
  deriving (Enum)

{-# LINE 48 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlSetFlag :: (HsQMLGlobalFlag) -> (Bool) -> IO ((Bool))
hsqmlSetFlag a1 a2 =
  let {a1' = enumToCInt a1} in 
  let {a2' = fromBool a2} in 
  hsqmlSetFlag'_ a1' a2' >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 53 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlGetFlag :: (HsQMLGlobalFlag) -> IO ((Bool))
hsqmlGetFlag a1 =
  let {a1' = enumToCInt a1} in 
  hsqmlGetFlag'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 57 "src/Graphics/QML/Internal/BindCore.chs" #-}


type TrivialCb = IO ()

foreign import ccall "wrapper"  
  marshalTrivialCb :: TrivialCb -> IO (FunPtr TrivialCb)

withTrivialCb :: TrivialCb -> (FunPtr TrivialCb -> IO a) -> IO a
withTrivialCb :: forall a. IO () -> (FunPtr (IO ()) -> IO a) -> IO a
withTrivialCb IO ()
f FunPtr (IO ()) -> IO a
with = IO () -> IO (FunPtr (IO ()))
marshalTrivialCb IO ()
f IO (FunPtr (IO ())) -> (FunPtr (IO ()) -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr (IO ()) -> IO a
with

withMaybeTrivialCb :: Maybe TrivialCb -> (FunPtr TrivialCb -> IO b) -> IO b
withMaybeTrivialCb :: forall b. Maybe (IO ()) -> (FunPtr (IO ()) -> IO b) -> IO b
withMaybeTrivialCb (Just IO ()
f) = IO () -> (FunPtr (IO ()) -> IO b) -> IO b
forall a. IO () -> (FunPtr (IO ()) -> IO a) -> IO a
withTrivialCb IO ()
f
withMaybeTrivialCb Maybe (IO ())
Nothing = \FunPtr (IO ()) -> IO b
cont -> FunPtr (IO ()) -> IO b
cont FunPtr (IO ())
forall a. FunPtr a
nullFunPtr

data HsQMLEventLoopStatus = HsqmlEvloopOk
                          | HsqmlEvloopAlreadyRunning
                          | HsqmlEvloopPostShutdown
                          | HsqmlEvloopWrongThread
                          | HsqmlEvloopNotRunning
                          | HsqmlEvloopOtherError
instance Enum HsQMLEventLoopStatus where
  succ HsqmlEvloopOk = HsqmlEvloopAlreadyRunning
  succ HsqmlEvloopAlreadyRunning = HsqmlEvloopPostShutdown
  succ HsqmlEvloopPostShutdown = HsqmlEvloopWrongThread
  succ HsqmlEvloopWrongThread = HsqmlEvloopNotRunning
  succ HsqmlEvloopNotRunning = HsqmlEvloopOtherError
  succ HsqmlEvloopOtherError = error "HsQMLEventLoopStatus.succ: HsqmlEvloopOtherError has no successor"

  pred HsqmlEvloopAlreadyRunning = HsqmlEvloopOk
  pred HsqmlEvloopPostShutdown = HsqmlEvloopAlreadyRunning
  pred HsqmlEvloopWrongThread = HsqmlEvloopPostShutdown
  pred HsqmlEvloopNotRunning = HsqmlEvloopWrongThread
  pred HsqmlEvloopOtherError = HsqmlEvloopNotRunning
  pred HsqmlEvloopOk = error "HsQMLEventLoopStatus.pred: HsqmlEvloopOk has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom :: HsQMLEventLoopStatus -> [HsQMLEventLoopStatus]
enumFrom HsQMLEventLoopStatus
from = HsQMLEventLoopStatus
-> HsQMLEventLoopStatus -> [HsQMLEventLoopStatus]
forall a. Enum a => a -> a -> [a]
enumFromTo HsQMLEventLoopStatus
from HsQMLEventLoopStatus
HsqmlEvloopOtherError

  fromEnum HsqmlEvloopOk = 0
  fromEnum HsqmlEvloopAlreadyRunning = 1
  fromEnum HsqmlEvloopPostShutdown = 2
  fromEnum HsqmlEvloopWrongThread = 3
  fromEnum HsqmlEvloopNotRunning = 4
  fromEnum HsqmlEvloopOtherError = 5

  toEnum 0 = HsqmlEvloopOk
  toEnum 1 = HsqmlEvloopAlreadyRunning
  toEnum 2 = HsqmlEvloopPostShutdown
  toEnum 3 = HsqmlEvloopWrongThread
  toEnum 4 = HsqmlEvloopNotRunning
  toEnum 5 = HsqmlEvloopOtherError
  toEnum unmatched = error ("HsQMLEventLoopStatus.toEnum: Cannot match " ++ show unmatched)

{-# LINE 71 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlEvloopRun :: (TrivialCb) -> (TrivialCb) -> (Maybe TrivialCb) -> IO ((HsQMLEventLoopStatus))
hsqmlEvloopRun a1 a2 a3 =
  withTrivialCb a1 $ \a1' -> 
  withTrivialCb a2 $ \a2' -> 
  withMaybeTrivialCb a3 $ \a3' -> 
  hsqmlEvloopRun'_ a1' a2' a3' >>= \res ->
  let {res' = cIntToEnum res} in
  return (res')

{-# LINE 77 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlEvloopRequire :: IO ((HsQMLEventLoopStatus))
hsqmlEvloopRequire =
  hsqmlEvloopRequire'_ >>= \res ->
  let {res' = cIntToEnum res} in
  return (res')

{-# LINE 81 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlEvloopRelease :: IO ()
hsqmlEvloopRelease =
  hsqmlEvloopRelease'_ >>
  return ()

{-# LINE 85 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlEvloopNotifyJobs :: IO ()
hsqmlEvloopNotifyJobs =
  hsqmlEvloopNotifyJobs'_ >>
  return ()

{-# LINE 89 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlEvloopShutdown :: IO ((HsQMLEventLoopStatus))
hsqmlEvloopShutdown =
  hsqmlEvloopShutdown'_ >>= \res ->
  let {res' = cIntToEnum res} in
  return (res')

{-# LINE 93 "src/Graphics/QML/Internal/BindCore.chs" #-}


newtype HsQMLEngineHandle = HsQMLEngineHandle (C2HSImp.ForeignPtr (HsQMLEngineHandle))
withHsQMLEngineHandle :: HsQMLEngineHandle -> (C2HSImp.Ptr HsQMLEngineHandle -> IO b) -> IO b
withHsQMLEngineHandle (HsQMLEngineHandle fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 95 "src/Graphics/QML/Internal/BindCore.chs" #-}


foreign import ccall "hsqml.h &hsqml_finalise_engine_handle"
  hsqmlFinaliseEngineHandlePtr :: FunPtr (Ptr (HsQMLEngineHandle) -> IO ())

newEngineHandle :: Ptr HsQMLEngineHandle -> IO HsQMLEngineHandle
newEngineHandle p = do
  fp <- newForeignPtr hsqmlFinaliseEngineHandlePtr p
  return $ HsQMLEngineHandle fp

hsqmlCreateEngine :: (Maybe HsQMLObjectHandle) -> (HsQMLStringHandle) -> (Ptr HsQMLStringHandle) -> (Ptr HsQMLStringHandle) -> (TrivialCb) -> IO ((HsQMLEngineHandle))
hsqmlCreateEngine a1 a2 a3 a4 a5 =
  withMaybeHsQMLObjectHandle a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  let {a4' = id a4} in 
  withTrivialCb a5 $ \a5' -> 
  hsqmlCreateEngine'_ a1' a2' a3' a4' a5' >>= \res ->
  newEngineHandle res >>= \res' ->
  return (res')

{-# LINE 111 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlKillEngine :: (HsQMLEngineHandle) -> IO ()
hsqmlKillEngine a1 =
  withHsQMLEngineHandle a1 $ \a1' -> 
  hsqmlKillEngine'_ a1' >>
  return ()

{-# LINE 115 "src/Graphics/QML/Internal/BindCore.chs" #-}


hsqmlSetDebugLoglevel :: (Int) -> IO ()
hsqmlSetDebugLoglevel a1 =
  let {a1' = fromIntegral a1} in 
  hsqmlSetDebugLoglevel'_ a1' >>
  return ()

{-# LINE 119 "src/Graphics/QML/Internal/BindCore.chs" #-}


foreign import ccall unsafe "Graphics/QML/Internal/BindCore.chs.h hsqml_init"
  hsqmlInit_'_ :: ((C2HSImp.FunPtr ((C2HSImp.FunPtr (IO ())) -> (IO ()))) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO ())))

foreign import ccall unsafe "Graphics/QML/Internal/BindCore.chs.h hsqml_set_args"
  hsqmlSetArgs'_ :: ((C2HSImp.Ptr (HsQMLStringHandle)) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Graphics/QML/Internal/BindCore.chs.h hsqml_get_args_count"
  hsqmlGetArgsCount'_ :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/QML/Internal/BindCore.chs.h hsqml_get_args"
  hsqmlGetArgs'_ :: ((C2HSImp.Ptr (HsQMLStringHandle)) -> (IO ()))

foreign import ccall unsafe "Graphics/QML/Internal/BindCore.chs.h hsqml_set_flag"
  hsqmlSetFlag'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Graphics/QML/Internal/BindCore.chs.h hsqml_get_flag"
  hsqmlGetFlag'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/QML/Internal/BindCore.chs.h hsqml_evloop_run"
  hsqmlEvloopRun'_ :: ((C2HSImp.FunPtr (IO ())) -> ((C2HSImp.FunPtr (IO ())) -> ((C2HSImp.FunPtr (IO ())) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/QML/Internal/BindCore.chs.h hsqml_evloop_require"
  hsqmlEvloopRequire'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/QML/Internal/BindCore.chs.h hsqml_evloop_release"
  hsqmlEvloopRelease'_ :: (IO ())

foreign import ccall unsafe "Graphics/QML/Internal/BindCore.chs.h hsqml_evloop_notify_jobs"
  hsqmlEvloopNotifyJobs'_ :: (IO ())

foreign import ccall unsafe "Graphics/QML/Internal/BindCore.chs.h hsqml_evloop_shutdown"
  hsqmlEvloopShutdown'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/QML/Internal/BindCore.chs.h hsqml_create_engine"
  hsqmlCreateEngine'_ :: ((C2HSImp.Ptr (HsQMLObjectHandle)) -> ((HsQMLStringHandle) -> ((C2HSImp.Ptr (HsQMLStringHandle)) -> ((C2HSImp.Ptr (HsQMLStringHandle)) -> ((C2HSImp.FunPtr (IO ())) -> (IO (C2HSImp.Ptr (HsQMLEngineHandle))))))))

foreign import ccall safe "Graphics/QML/Internal/BindCore.chs.h hsqml_kill_engine"
  hsqmlKillEngine'_ :: ((C2HSImp.Ptr (HsQMLEngineHandle)) -> (IO ()))

foreign import ccall unsafe "Graphics/QML/Internal/BindCore.chs.h hsqml_set_debug_loglevel"
  hsqmlSetDebugLoglevel'_ :: (C2HSImp.CInt -> (IO ()))