{-# OPTIONS_GHC -Wall #-}
{-|
Module      : NET
Description : Interop'ing with .NET from Haskell.
Copyright   : (c) Sigbjorn Finne, 2008-2009
License     : BSD3

Maintainer  : Sigbjorn Finne <sof@forkIO.com>
Stability   : provisional
Portability : portable

@hs-dotnet@ lets you more tightly integrate the .NET platform with
Haskell, supporting the bi-directional use of both .NET code from Haskell,
and Haskell code from .NET. This is the toplevel module for the package; simply include 
it in the Haskell modules you wish to use .NET from Haskell. Here's a simple example:

> module Main(main) where
> import NET
> getEnv :: String -> IO String
> getEnv nm = invokeStatic "System.Environment" "GetEnvironmentVariable" nm
> main = do { v <- getEnv "COMSPEC"; putStrLn v }

For demos showing some of what you can do using this package, please consult the @examples/@
subdirectory in the distribution.
-}
module NET 
       ( module NET.Base
       , new
       , newGeneric
       , createObject

       , invoke
       , invoke_
       , invokeGeneric
       , invokeGeneric_

       , invokeStatic
       , invokeStatic_
       
       , invokeGenericStatic
       , invokeGenericStatic_
       
       , getField
       , getFieldStatic
       
       , setField
       , setFieldStatic
       
       , Class(..)
       , Method(..)
       
       , parseEnumValue
       
       , 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 ()

-- | @newGeneric className param@ is a convenience function for creating new objects
-- to classes that have a generic type. It takes care of encoding the generic class name +
-- its type parameter instantiation for you.
-- 
newGeneric :: Type a => ClassName -> a -> IO (Object b)
newGeneric clsName v = new (toGenericTypeString clsName (tyName v))

-- | @createObject className args@ is the object constructor for when you want the
-- nullary constructor @new@ isn't appropriate, but you want to pass in arguments
-- to the constructor.
createObject :: (Arg a) => ClassName -> a -> IO (Object b)
createObject clsName args = createObj clsName (arg_ args)

-- | @invoke methName args thisPtr@ invokes the method @methName@ on
-- the object, passing along the argument @args@ (multiple arguments are
-- passed in using tuples). The convention of putting the /this/ pointer
-- last is so that you can use the @(#)@ operator to mimic an OO-like invocation
-- syntax:
--
-- >  x <- (myObj # invoke "Add" (2::Int,4::Int)) :: IO Int
-- 
-- The @invoke@ method returns the method result as an overloaded 'Result' value.
-- It is the @invoke@ caller's responsibility to constrain that type to one that
-- is compatible with what the underying .NET method actually returns. Either
-- by defining a wrapper function (along with its signature), constrain like in
-- the above, or use the @hswrap@ tool for generating complete Haskell module 
-- wrapper to .NET types.
--
invoke :: (Arg a, Result res)
       => MethodName
       -> a
       -> Object b
       -> IO res
invoke methName args obj = do
  res   <- obj # invokeMethod methName [] (arg_ args)
  return res

-- | @invoke_ methName args thisPtr@ performs method invocation just like 'invoke',
-- but ignores the result. Using it over @invoke@ has the benefit that you don't
-- have to disambiguate the result value.
invoke_ :: (Arg a)
        => MethodName
        -> a
        -> Object b
        -> IO ()
invoke_ methName args obj = invoke methName args obj

-- | @invokeGeneric methName typeArgs args thisPtr@ is the method invocation operation
-- for objects with .NET classes that are parameterized over types (i.e., /generic types/.)
-- It differs from 'invoke' in that it takes an extra argument holding the type names
-- that the generic type (and method) is instantiated over.
--
invokeGeneric :: (Arg a, Result res)
              => MethodName
	      -> [TypeName]
              -> a
              -> Object b
              -> IO res
invokeGeneric methName tyArgs args obj = do
  res   <- obj # invokeMethod methName tyArgs (arg_ args)
  return res

-- | @invokeGeneric_ methName typeArgs args thisPtr@ is the generic type version
-- of 'invoke_', ignoring the result of the method call. See 'invokeGeneric' for 
-- more on how generic methods are invoked.
invokeGeneric_ :: (Arg a)
               => MethodName
	       -> [TypeName]
               -> a
               -> Object b
               -> IO ()
invokeGeneric_ methName tyArgs args obj = 
  invokeGeneric methName tyArgs args obj


-- | @invokeStatic_ clsName methName args@ calls the static method @clsName.methName@, but
-- ignores any result value.
invokeStatic_ :: Arg a
 	      => ClassName
	      -> MethodName
              -> a
              -> IO ()
invokeStatic_ clsName methName args = 
  invokeStaticMethod clsName methName [] (arg_ args) 

-- | @invokeStatic clsName methName args@ calls the static method @clsName.methName@
-- passing along the arguments @args@ (tupled up if more than one.) The result has
-- to be a value that is an instance of the 'Result' type class. As an example, here
-- is how to bind to @System.Environment.GetFolderPath@:
--
-- > getDesktopFolder :: IO String
-- > getDesktopFolder = do
-- >       val <- parseEnumValue "System.Environment+SpecialFolder" "Desktop"
-- >       invokeStatic "System.Environment" "GetFolderPath" val
--
-- making use of 'parseEnumValue' for constructing the required enumerated type value
-- expected by @GetFolderPath@.
-- 
invokeStatic :: (Arg a, Result b)
 	     => ClassName
	     -> MethodName
             -> a
             -> IO b
invokeStatic clsName methName args = 
  invokeStaticMethod clsName methName [] (arg_ args) 

-- | @invokeGenericStatic_ className methName typeArgs args@ is the static method invocation
-- operator for classes and methods with parameterized/generic types, ignoring the result.
-- See 'invokeGeneric' for more information on what the extra @typeArgs@ argument specify.
invokeGenericStatic_ :: Arg a
	 	     => ClassName
	      	     -> MethodName
	             -> [TypeName]
                     -> a
                     -> IO ()
invokeGenericStatic_ clsName methName tyPs args = do
  invokeStaticMethod clsName methName tyPs (arg_ args) 

-- | @invokeGenericStatic_ className methName typeArgs args@ is the static method invocation
-- operator for classes and methods with parameterized/generic types, the result being a value
-- that's a 'Result' instance. See 'invokeGeneric' for more information on what the extra
-- @typeArgs@ argument specify.
invokeGenericStatic :: (Arg a, Result b)
 	            => ClassName
	            -> MethodName
	            -> [TypeName]
                    -> a
                    -> IO b
invokeGenericStatic clsName methName typeArgs args = do
--  print typeArgs
  invokeStaticMethod clsName methName typeArgs (arg_ args) 

-- | @getField fName args this@ accesses the value of the @fName@ field
-- of the @this@ object. It supports indexed/parameterized properties through
-- @args@. If the field/property is non-parameterized, simply pass in @()@.
--
-- The result is overloaded to one of the .NET 'Result' type instances.
getField :: (Arg a, Result b) => FieldName -> a -> Object i -> IO b
getField fName a obj = getFieldB fName (arg_ a) obj

-- | @getFieldStatic className fName args@ access the static field @fName@. Otherwise
-- like 'getField'.
getFieldStatic :: (Arg a, Result b) => ClassName -> FieldName -> a -> IO b
getFieldStatic cName fName a = getFieldStaticB cName fName (arg_ a) 

-- | @setField fName val this@ assigns the field @fName@ of object @this@ the
-- new value @val@.
setField :: (Arg a) => FieldName -> a -> Object i -> IO ()
setField fName a obj = setFieldB fName (arg_ a) obj

-- | @setFieldStatic className fName val@ is the operation for assigning a
-- new value to a static field.
setFieldStatic :: (Arg a) => ClassName -> FieldName -> a -> IO ()
setFieldStatic cName fName a = setFieldStaticB cName fName (arg_ a) 

-- | @parseEnumValue className tagName@ tries to create an enum value for the .NET
-- enumeration @className.tagName@ (e.g., @System.TypeCode.Object@.)
parseEnumValue :: String -> String -> IO (Object ())
parseEnumValue cls tag = catchNET (do
   tyObj <- invokeStatic "System.Type" "GetType" cls
   invokeStatic "System.Enum" "Parse" (tyObj :: Object (), tag))
  (\ _ -> fail ("NET.parseEnumValue: failed to locate " ++ cls ++ '.':tag))

-- | 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'
-}

-- | @msgBox caption msg@ pops up the ubiq message box; caption and text as arguments.
-- Mostly for debugging.
msgBox :: String -> String -> IO ()
msgBox caption msg = invokeStatic "System.Windows.Forms.MessageBox" "Show" (msg,caption)