{-# OPTIONS_GHC -fglasgow-exts -XUndecidableInstances #-}
--------------------------------------------------------------------
-- |
-- Module      : NET
-- Description : An interface to .NET for Haskell.
-- Copyright   : (c) Sigbjorn Finne, 2008
-- License     : BSD3
--
-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>
-- Stability   : provisional
-- Portability : portable
--
-- An interface to .NET for Haskell.
-- 
--------------------------------------------------------------------
module NET 
       ( module NET.Base
       , new
       , createObject

       , invoke
       , invoke_

       , invokeStatic
       , invokeStatic_
       
       , getField
       , getFieldStatic
       
       , setField
       , setFieldStatic
       
       , newString

       , Class(..)
       , Method(..)
       
       , msgBox
       ) where

import NET.Base

-- createObject "System.Xml" "XmlTextReader" [arg "c:\\tmp\\haskell\\dotnet\\foo.xml"] >>= \ obj -> getField obj "XmlLang" [] >>= \x -> putStrLn x
-- createObject "System.Windows.Forms" "MessageBox" [] >>= \ obj -> getField obj "XmlLang" [] >>= \x -> putStrLn x

-- | @new className@ instantiates a new object via its
-- nullary constructor.
new :: ClassName -> IO (Object a)
new clsName = createObject clsName ()

createObject :: (NetType a) => ClassName -> a -> IO (Object b)
createObject clsName args = createObj clsName (arg args)

newString :: String -> IO (Object a)
newString s = createObject "System.String" s

invoke :: (NetType a, NetType res)
       => MethodName
       -> a
       -> Object b
       -> IO res
invoke methName args obj = do
  res   <- obj # invokeMethod methName (arg args)
  return res

invoke_ :: (NetType a)
        => MethodName
        -> a
        -> Object b
        -> IO ()
invoke_ methName args obj = invoke methName args obj

invokeStatic_ :: NetType a
 	      => ClassName
	      -> MethodName
              -> a
              -> IO ()
invokeStatic_ clsName methName args = invokeStaticMethod clsName methName (arg args)

invokeStatic :: (NetType a, NetType b)
 	     => ClassName
	     -> MethodName
             -> a
             -> IO b
invokeStatic clsName methName args = invokeStaticMethod clsName methName (arg args)

getField :: (NetType a, NetType b) => FieldName -> a -> Object i -> IO b
getField fName a obj = getFieldB fName (arg a) obj

getFieldStatic :: (NetType a, NetType b) => ClassName -> FieldName -> a -> IO b
getFieldStatic cName fName a = getFieldStaticB cName fName (arg a) 

setField :: (NetType a) => FieldName -> a -> Object i -> IO ()
setField fName a obj = setFieldB fName (arg a) obj

setFieldStatic :: (NetType a) => ClassName -> FieldName -> a -> IO ()
setFieldStatic cName fName a = setFieldStaticB cName fName (arg a) 

{-
foreign import dotnet
  "static Hugs.Wrapper.DefineDelegator"
  defineDelegator :: String -> StablePtr a -> IO String
-}

{-
newDelegator :: (Object a -> Object b -> IO ())
	     -> IO (Object (System (Delegate ())))
newDelegator fun = do
  sp   <- newStablePtr (delegatorWrapper fun)
  tyNm <- defineDelegator "Delegate" sp
  obj  <- new tyNm
  obj # fieldGet "Delegate_handler"
 where
   delegatorWrapper :: (Object a -> Object b -> IO ())
   		    -> Object a -> Object b -> IO ()
   delegatorWrapper inner obj1 obj2 = inner obj1 obj2
-}

-- | To support the creation of .NET classes/types whose methods
-- are implemented in Haskell, we provide the Class and Method
-- data types. Experimental (and not yet 'online.')
data Class 
 = Class 
     { netClassName    :: String	       -- type/class name
     , netClassSuper   :: (Maybe String) -- Just x => derive from x
     , netClassMethods :: [Method]
     }

-- | The @Method@ type describes the mapping between a .NET method,
-- and a Haskell function value which implements it. Type safe?
data Method
 = Method
     { methodName      :: MethodName            -- .NET name (class-local/unqualified).
     , methodOverride  :: Bool                  -- True => override.
     , methodHsFunc    :: String                -- Haskell function that implements it
     , methodArgTypes  :: [NETBridgeType]       -- Argument types
     , methodResType   :: (Maybe NETBridgeType) -- result (Nothing => void).
     }

{-
foreign import dotnet
  "static Hugs.Wrapper.DefineType"
  defineType :: String -> String -> String -> IO String

-- create a new class/type + an instance of it (via the default constructor.)
defineClass :: Class -> IO (Object b)
defineClass cls@(Class clsName mbFrom meths) = do
  tyStr    <- defineType clsName superTy methString
  if (null tyStr)
   then ioError (userError "unable to create class")
   else new tyStr
 where
  superTy    = fromMaybe "" mbFrom
  methString = concat $ intersperse "/" $ map mkFunctionInfo meths

  mkFunctionInfo (Method name override haskellFun argus mbRes) =
    name ++ '#':haskellFun ++ 
    '|':map toTag argus ++ 
    ['|', fromMaybe 'V' (fmap toTag mbRes)]

  toTag x = 
    case x of
      ObjectTy{} -> 'O'
      StringTy   -> 'S'
      IntTy      -> 'I'
      VoidTy     -> 'V'
-}

-- | The ubiq message box; caption and text as arguments.
msgBox :: String -> String -> IO ()
msgBox caption msg = invokeStatic "System.Windows.Forms.MessageBox" "Show" (msg,caption)