/*
 * Entry points needed to implement a COM inproc server.
 * The C wrappers defined here delegate to (library) methods
 * implemented in Haskell.
 *
 * Sigbjorn Finne, 1999
 */

#include <windows.h>
#include "comPrim.h"
#include "RtsAPI.h"
#include <stdio.h>
#include "Rts.h"
#include "RtsMessages.h"

/*
 * A Haskell in-proc server exposes a VTBL which mimics
 * the entry points that a self-registering inproc server
 * has to supply to the outside world.
 *
 */
typedef struct IComDll {
   void    (*dllUnload)();
   HRESULT (*dllCanUnloadNow)();
   HRESULT (*dllRegisterServer)();
   HRESULT (*dllUnregisterServer)();
   HRESULT (*dllGetClassObject)(CLSID* clsid, IID* iid,
			        void** ppv);
} ComDll;

ComDll* comDll     = NULL;
HMODULE gDllModule = NULL;

extern ComDll* newComDll ( HANDLE hMod );

#if __GLASGOW_HASKELL__ >= 408 && __GLASGOW_HASKELL__ < 605
extern void  __stginit_ComDllMain(void);
#endif

#ifdef DEBUG_MODE
static char* args[] = { "vs_haskell.dll", "+RTS", "-Sstderr", "-I2" };
#else
static char* args[] = { "vs_haskell.dll", "+RTS", "-I2" };
#endif

BOOL
STDCALL
DllMain
   ( HANDLE hModule
   , DWORD reason
   , void* reserved
   )
{
    // Useful to break here when debugging, so we can set breakpoints
    // when the DLL has loaded:
    // DebugBreak();

    if (reason == DLL_PROCESS_ATTACH) {
      /* By now, the RTS DLL should have been hoisted in, but we need to start
         it up.

	 Note: for ghc-4.08 and later, you need to give the main / 'root module'
	 of the Haskell you want to start running. So, if this is something other
	 than 'ComDllMain', you'll need to tweak the invocation below.
      */
#if __GLASGOW_HASKELL__ >= 408
      startupHaskell( sizeof(args) / sizeof(char*)
		    , args
#if __GLASGOW_HASKELL__ >= 605
		    , NULL
#else
		    , &__stginit_ComDllMain
#endif
		    );
#else
      startupHaskell(sizeof(args) / sizeof(char*), args);
#endif
      gDllModule = hModule;
      return TRUE;
  } else {
    if (comDll && reason == DLL_PROCESS_DETACH) {
        // (comDll)->dllUnload();
	comDll = NULL;
	gDllModule = NULL;
	shutdownHaskell();
    }
    return TRUE;
  }
}

HRESULT
STDCALL
DllCanUnloadNow (void)
{
    if (comDll) {
	return (comDll)->dllCanUnloadNow();
    } else {
	return S_OK;
  }
}

HRESULT
STDCALL
DllRegisterServer (void)
{
    if (!comDll) {
	comDll = newComDll(gDllModule);
    }
    if (comDll) {
	return (comDll)->dllRegisterServer();
    } else {
	return E_FAIL;
    }
}

HRESULT
STDCALL
DllUnregisterServer (void)
{
    if (!comDll) {
	comDll = newComDll(gDllModule);
    }
    if (comDll) {
	return (comDll)->dllUnregisterServer();
    } else {
	return E_FAIL;
    }
}

HRESULT
STDCALL
DllInstall(BOOL bInstall, LPCWSTR pszCmdLine)
{
	int len;
	char **new_args;
	char *cmdline;

	if (!pszCmdLine)
		return S_OK;

	len = WideCharToMultiByte (CP_ACP, 0, pszCmdLine, -1, NULL, 0, NULL, NULL);
	if (!len)
		return HRESULT_FROM_WIN32(GetLastError());

	new_args = malloc(sizeof(char*)*2+len+1);
	if (!new_args)
		return HRESULT_FROM_WIN32(ERROR_NOT_ENOUGH_MEMORY);
	cmdline = (char*) (new_args+2);

	if (!WideCharToMultiByte(CP_ACP, 0, pszCmdLine, -1, cmdline, len, NULL, NULL))
		return HRESULT_FROM_WIN32(GetLastError());

	new_args[0] = args[0];
	new_args[1] = cmdline;
	setProgArgv(2,new_args);

	return (bInstall ? DllRegisterServer() : DllUnregisterServer());
};

STDAPI DllGetClassObject(REFCLSID rclsid,REFIID riid,PVOID *ppv)
{
    HRESULT hr;
    if (!comDll) {
	comDll = newComDll(gDllModule);
    }
    if (comDll) {
	hr = (comDll)->dllGetClassObject(rclsid, riid, ppv);
	return S_OK;
    } else {
	return E_FAIL;
    }
}