packages feed

HJVM (empty) → 0.1

raw patch · 17 files changed

+2235/−0 lines, 17 filesdep +Cabaldep +HJVMdep +HUnitsetup-changedbinary-added

Dependencies added: Cabal, HJVM, HUnit, base, containers, filepath, haskell-src-exts, mtl, parsec, process, test-framework, test-framework-hunit, transformers

Files

+ HJVM.cabal view
@@ -0,0 +1,57 @@+Name:           HJVM
+Version:        0.1
+Build-Type:     Simple
+cabal-version:  >= 1.8
+extra-source-files:  src/libjvm.dll.a,src/Language/Java/JVM/hjvm.h
+stability:      Experimental
+author:         JP Moresmau
+maintainer:     jp@moresmau.fr
+synopsis:       A library to create a Java Virtual Machine and manipulate Java objects
+description:    Uses FFI to access JNI to create a JVM. Then the library lets you create and manipulate Java objects. 
+                There is also a code generator to generate wrapper Haskell code
+homepage:       https://github.com/JPMoresmau/HJVM
+category:       Language
+license-file:   LICENSE
+license:        BSD3
+copyright:      Copyright 2011-2012, JP Moresmau
+extra-source-files: README.md
+
+library
+  hs-source-dirs:     src 
+  build-depends:      
+                      base < 5,
+                      containers,
+                      mtl,
+                      transformers,
+                      process,
+                      filepath,
+                      parsec >= 3,
+                      haskell-src-exts
+  exposed-modules:    Language.Java.JVM.API, Language.Java.JVM.Types, Language.Java.JVM.Generator, Language.Java.JVM.JavapParser, Language.Java.JVM.SignatureParser
+  includes:           src/Language/Java/JVM/hjvm.h
+  c-sources:          src/Language/Java/JVM/hjvm.c
+  extra-libraries:    jvm
+  ghc-options:        -Wall -fno-warn-unused-do-bind
+  
+Test-Suite hjvm-test
+  type:           exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is:        Main.hs
+  build-depends:  
+                  base < 5,
+                  Cabal >= 1.9.2,
+                  HJVM,
+                  HUnit,
+                  mtl,
+                  transformers,
+                  parsec >= 3,
+                  haskell-src-exts,
+                  test-framework,
+                  test-framework-hunit
+  other-modules:  Language.Java.JVM.APITest, Language.Java.JVM.JavapParserTest, Language.Java.JVM.GeneratorTest, Language.Java.JVM.SignatureParserTest
+  ghc-options:    -Wall -fno-warn-unused-do-bind
+  x-uses-tf:       true
+
+source-repository head
+  type:     git
+  location: git://github.com/JPMoresmau/HJVM.git
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright 2011-2012, JP Moresmau
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+- Neither name of the author nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) AND THE CONTRIBUTORS "AS
+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY
+COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
+IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,8 @@+# HJVM
+
+The HJVM project aims at integrating a Java Virtual Machine inside Haskell Code.
+
+It allows launching a JVM from Haskell and manipulating the Java objects. 
+
+There is a also a binding generator to generate Haskell bindings to Java objects.
+
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell
+import Distribution.Simple
+main :: IO ()
+main = defaultMain
+ src/Language/Java/JVM/API.hs view
@@ -0,0 +1,502 @@+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, FlexibleContexts, FlexibleInstances, RankNTypes,MultiParamTypeClasses #-}
+module Language.Java.JVM.API where
+
+import Language.Java.JVM.Types
+
+import Control.Monad
+import qualified Data.Map as Map
+
+import Foreign.C
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
+import Control.Concurrent.MVar
+import Control.Monad.IO.Class
+import Control.Monad.State
+
+import Text.Printf
+
+foreign import ccall safe "start" f_start ::CString -> IO (CLong)
+foreign import ccall safe "end" f_end :: IO ()
+--foreign import ccall "test" test ::CInt -> IO (CInt)
+
+foreign import ccall safe "findClass" f_findClass :: CString -> IO (JClassPtr)
+foreign import ccall safe "freeClass" f_freeClass :: JClassPtr -> IO ()
+foreign import ccall safe "freeObject" f_freeObject :: JObjectPtr -> IO ()
+foreign import ccall safe "findMethod" f_findMethod :: JClassPtr -> CString -> CString -> IO (JMethodPtr)
+foreign import ccall safe "findStaticMethod" f_findStaticMethod :: JClassPtr -> CString -> CString -> IO (JMethodPtr)
+foreign import ccall safe "findField" f_findField :: JClassPtr -> CString -> CString -> IO (JFieldPtr)
+foreign import ccall safe "findStaticField" f_findStaticField :: JClassPtr -> CString -> CString -> IO (JFieldPtr)
+foreign import ccall safe "newObject" f_newObject :: JClassPtr -> JMethodPtr -> JValuePtr -> CWString -> IO (JObjectPtr)
+foreign import ccall safe "newString" f_newString :: CWString -> CLong  -> CWString-> IO (JObjectPtr)
+
+foreign import ccall safe "callIntMethod" f_callIntMethod :: JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CLong)
+foreign import ccall safe "callCharMethod" f_callCharMethod :: JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CUShort)
+foreign import ccall safe "callVoidMethod" f_callVoidMethod :: JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO ()
+foreign import ccall safe "callBooleanMethod" f_callBooleanMethod ::  JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CUChar)
+foreign import ccall safe "callByteMethod" f_callByteMethod ::  JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CChar)
+foreign import ccall safe "callLongMethod" f_callLongMethod ::  JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CLong)
+foreign import ccall safe "callShortMethod" f_callShortMethod ::  JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CShort)
+foreign import ccall safe "callFloatMethod" f_callFloatMethod ::  JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CFloat)
+foreign import ccall safe "callDoubleMethod" f_callDoubleMethod ::  JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CDouble)
+foreign import ccall safe "callObjectMethod" f_callObjectMethod ::  JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (JObjectPtr)
+
+foreign import ccall safe "callStaticIntMethod" f_callStaticIntMethod :: JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CLong)
+foreign import ccall safe "callStaticCharMethod" f_callStaticCharMethod :: JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CUShort)
+foreign import ccall safe "callStaticVoidMethod" f_callStaticVoidMethod :: JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO ()
+foreign import ccall safe "callStaticBooleanMethod" f_callStaticBooleanMethod ::  JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CUChar)
+foreign import ccall safe "callStaticByteMethod" f_callStaticByteMethod ::  JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CChar)
+foreign import ccall safe "callStaticLongMethod" f_callStaticLongMethod ::  JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CLong)
+foreign import ccall safe "callStaticShortMethod" f_callStaticShortMethod ::  JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CShort)
+foreign import ccall safe "callStaticFloatMethod" f_callStaticFloatMethod ::  JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CFloat)
+foreign import ccall safe "callStaticDoubleMethod" f_callStaticDoubleMethod ::  JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (CDouble)
+foreign import ccall safe "callStaticObjectMethod" f_callStaticObjectMethod ::  JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO (JObjectPtr)
+
+foreign import ccall safe "getStaticIntField" f_getStaticIntField :: JClassPtr -> JFieldPtr -> CWString-> IO (CLong)
+foreign import ccall safe "getStaticBooleanField" f_getStaticBooleanField :: JClassPtr -> JFieldPtr -> CWString-> IO (CUChar)
+foreign import ccall safe "getStaticCharField" f_getStaticCharField :: JClassPtr -> JFieldPtr -> CWString-> IO (CUShort)
+foreign import ccall safe "getStaticShortField" f_getStaticShortField :: JClassPtr -> JFieldPtr -> CWString-> IO (CShort)
+foreign import ccall safe "getStaticByteField" f_getStaticByteField :: JClassPtr -> JFieldPtr -> CWString-> IO (CChar)
+foreign import ccall safe "getStaticLongField" f_getStaticLongField :: JClassPtr -> JFieldPtr -> CWString-> IO (CLong)
+foreign import ccall safe "getStaticDoubleField" f_getStaticDoubleField :: JClassPtr -> JFieldPtr -> CWString-> IO (CDouble)
+foreign import ccall safe "getStaticFloatField" f_getStaticFloatField :: JClassPtr -> JFieldPtr -> CWString-> IO (CFloat)
+foreign import ccall safe "getStaticObjectField" f_getStaticObjectField :: JClassPtr -> JFieldPtr -> CWString-> IO (JObjectPtr)
+
+foreign import ccall safe "setStaticIntField" f_setStaticIntField :: JClassPtr -> JFieldPtr-> CLong  -> CWString -> IO ()
+foreign import ccall safe "setStaticBooleanField" f_setStaticBooleanField :: JClassPtr -> JFieldPtr-> CUChar -> CWString -> IO ()
+foreign import ccall safe "setStaticCharField" f_setStaticCharField :: JClassPtr -> JFieldPtr-> CUShort  -> CWString-> IO ()
+foreign import ccall safe "setStaticShortField" f_setStaticShortField :: JClassPtr -> JFieldPtr-> CShort -> CWString -> IO ()
+foreign import ccall safe "setStaticByteField" f_setStaticByteField :: JClassPtr -> JFieldPtr -> CChar -> CWString-> IO ()
+foreign import ccall safe "setStaticLongField" f_setStaticLongField :: JClassPtr -> JFieldPtr -> CLong -> CWString-> IO ()
+foreign import ccall safe "setStaticDoubleField" f_setStaticDoubleField :: JClassPtr -> JFieldPtr-> CDouble  -> CWString-> IO ()
+foreign import ccall safe "setStaticFloatField" f_setStaticFloatField :: JClassPtr -> JFieldPtr-> CFloat -> CWString -> IO ()
+foreign import ccall safe "setStaticObjectField" f_setStaticObjectField :: JClassPtr -> JFieldPtr -> JObjectPtr -> CWString -> IO ()
+
+foreign import ccall safe "getIntField" f_getIntField :: JObjectPtr -> JFieldPtr -> CWString-> IO (CLong)
+foreign import ccall safe "getBooleanField" f_getBooleanField :: JObjectPtr -> JFieldPtr -> CWString-> IO (CUChar)
+foreign import ccall safe "getCharField" f_getCharField :: JObjectPtr -> JFieldPtr -> CWString-> IO (CUShort)
+foreign import ccall safe "getShortField" f_getShortField :: JObjectPtr -> JFieldPtr -> CWString-> IO (CShort)
+foreign import ccall safe "getByteField" f_getByteField :: JObjectPtr -> JFieldPtr -> CWString-> IO (CChar)
+foreign import ccall safe "getLongField" f_getLongField :: JObjectPtr -> JFieldPtr -> CWString-> IO (CLong)
+foreign import ccall safe "getDoubleField" f_getDoubleField :: JObjectPtr -> JFieldPtr -> CWString-> IO (CDouble)
+foreign import ccall safe "getFloatField" f_getFloatField :: JObjectPtr -> JFieldPtr -> CWString-> IO (CFloat)
+foreign import ccall safe "getObjectField" f_getObjectField :: JObjectPtr -> JFieldPtr -> CWString-> IO (JObjectPtr)
+
+foreign import ccall safe "setIntField" f_setIntField :: JObjectPtr -> JFieldPtr-> CLong  -> CWString -> IO ()
+foreign import ccall safe "setBooleanField" f_setBooleanField :: JObjectPtr -> JFieldPtr-> CUChar -> CWString -> IO ()
+foreign import ccall safe "setCharField" f_setCharField :: JObjectPtr -> JFieldPtr-> CUShort  -> CWString-> IO ()
+foreign import ccall safe "setShortField" f_setShortField :: JObjectPtr -> JFieldPtr-> CShort -> CWString -> IO ()
+foreign import ccall safe "setByteField" f_setByteField :: JObjectPtr -> JFieldPtr -> CChar -> CWString-> IO ()
+foreign import ccall safe "setLongField" f_setLongField :: JObjectPtr -> JFieldPtr -> CLong -> CWString-> IO ()
+foreign import ccall safe "setDoubleField" f_setDoubleField :: JObjectPtr -> JFieldPtr-> CDouble  -> CWString-> IO ()
+foreign import ccall safe "setFloatField" f_setFloatField :: JObjectPtr -> JFieldPtr-> CFloat -> CWString -> IO ()
+foreign import ccall safe "setObjectField" f_setObjectField :: JObjectPtr -> JFieldPtr -> JObjectPtr -> CWString -> IO ()
+
+foreign import ccall safe "registerCallback" f_registerCallback :: CString -> CString -> CString -> FunPtr CallbackInternal -> IO()
+
+foreign import ccall "wrapper" wrap :: CallbackInternal -> IO (FunPtr CallbackInternal)
+
+withJava :: String -> JavaT a -> IO a
+withJava = withJava' True
+
+withJava' :: Bool -> String -> JavaT a -> IO a
+withJava' end options f= do
+      ret<-withCString options (\s->f_start s)
+      when (ret < 0) (ioError $ userError "could not start JVM")
+      (a,s)<-runStateT f (JavaCache Map.empty Map.empty  Map.empty)
+      when end (evalStateT endJava s)
+      return a
+
+endJava :: JavaT()
+endJava = do
+        jc<-getJavaCache
+        liftIO $ mapM_ (\ptr->f_freeClass ptr) (Map.elems $ jc_classes jc)
+        putJavaCache (JavaCache Map.empty Map.empty Map.empty)
+        liftIO $ f_end 
+
+--withJavaRT :: (JRuntimePtr -> IO (a)) -> JavaT a 
+--withJavaRT f=do
+--        rt<-get
+--        r<-liftIO $ f rt
+--        return r
+
+registerCallBackMethod:: (WithJava m) => String -> String -> String -> m (CallbackMapRef)
+registerCallBackMethod cls method eventCls =do
+        jc<-getJavaCache
+        ior<-liftIO $ newMVar Map.empty
+        eventW<-liftIO $ wrap (event jc ior )
+        liftIO $ withCString cls
+                (\clsn->withCString method
+                        (\methodn->withCString eventCls
+                                (\eventClsn->f_registerCallback clsn methodn eventClsn eventW)))
+        return ior
+
+addCallBack :: (WithJava m) => CallbackMapRef  -> Callback  -> m(CLong)
+addCallBack cmr cb=do
+        liftIO $ modifyMVar cmr (\m-> do
+                let index=fromIntegral $ Map.size m
+                return (Map.insert index cb m,index))
+
+findClass :: (WithJava m) => ClassName -> m JClassPtr 
+findClass name=do
+        jc<-getJavaCache
+        let mptr=Map.lookup name (jc_classes jc)
+        case mptr of
+              Just ptr->return ptr
+              Nothing->do  
+                ptr<-liftIO $ withCString name (\s->f_findClass s)
+                putJavaCache (jc{jc_classes=Map.insert name ptr $ jc_classes jc})
+                return ptr
+
+
+withClass :: (WithJava m) => ClassName -> (JClassPtr->m a) -> m a
+withClass className f= findClass (className)>>=(\cls->do
+                        when (cls==nullPtr) (liftIO $ ioError $ userError $ printf "class %s not found" className)
+                        f cls)
+
+
+freeClass :: (WithJava m) => ClassName -> m ()
+freeClass name=do
+        jc<-getJavaCache
+        let mptr=Map.lookup name (jc_classes jc)
+        case mptr of
+              Just ptr->do
+                liftIO $ f_freeClass ptr
+                putJavaCache (jc{jc_classes=Map.delete name $ jc_classes jc})
+              Nothing->return ()
+
+findMethod :: (WithJava m) => Method -> m JMethodPtr
+findMethod meth=do
+        jc<-getJavaCache
+        let mptr=Map.lookup meth (jc_methods jc)
+        case mptr of
+              Just ptr->return ptr
+              Nothing -> do
+                withClass (m_class meth) (\cls->do
+                        ptr<- liftIO $ withCString (m_name meth)
+                                (\m->withCString (m_signature meth)
+                                        (\s->f_findMethod cls m s
+                                                ))
+                        putJavaCache (jc{jc_methods=Map.insert meth ptr $ jc_methods jc})
+                        return ptr)
+
+findStaticMethod :: (WithJava m) => Method -> m JMethodPtr
+findStaticMethod meth=do
+        jc<-getJavaCache
+        let mptr=Map.lookup meth (jc_methods jc)
+        case mptr of
+              Just ptr->return ptr
+              Nothing -> do
+                withClass (m_class meth) (\cls->do
+                        ptr<- liftIO $ withCString (m_name meth)
+                                (\m->withCString (m_signature meth)
+                                        (\s->f_findStaticMethod cls m s
+                                                ))
+                        putJavaCache (jc{jc_methods=Map.insert meth ptr $ jc_methods jc})
+                        return ptr)
+
+withMethod :: (WithJava m) =>  Method -> (JMethodPtr -> m a) -> m a
+withMethod mp f=do
+        mid<-findMethod mp
+        when (mid==nullPtr) (liftIO $ ioError $ userError $ printf "method %s not found" $ show mp)
+        f mid
+
+withStaticMethod :: (WithJava m) =>  Method -> (JMethodPtr -> m a) -> m a
+withStaticMethod mp f=do
+        mid<-findStaticMethod mp
+        when (mid==nullPtr) (liftIO $ ioError $ userError $ printf "static method %s not found" $ show mp)
+        f mid
+
+findField :: (WithJava m) => Field -> m JFieldPtr
+findField field=do
+        jc<-getJavaCache
+        let mptr=Map.lookup field (jc_fields jc)
+        case mptr of
+              Just ptr->return ptr
+              Nothing -> do
+                withClass (f_class field) (\cls->do
+                        ptr<- liftIO $ withCString (f_name field)
+                                (\m->withCString (f_signature field)
+                                        (\s->f_findField cls m s
+                                                ))
+                        putJavaCache (jc{jc_fields=Map.insert field ptr $ jc_fields jc})
+                        return ptr)
+
+findStaticField :: (WithJava m) => Field -> m JFieldPtr
+findStaticField field=do
+        jc<-getJavaCache
+        let mptr=Map.lookup field (jc_fields jc)
+        case mptr of
+              Just ptr->return ptr
+              Nothing -> do
+                withClass (f_class field) (\cls->do
+                        ptr<- liftIO $ withCString (f_name field)
+                                (\m->withCString (f_signature field)
+                                        (\s->f_findStaticField cls m s
+                                                ))
+                        putJavaCache (jc{jc_fields=Map.insert field ptr $ jc_fields jc})
+                        return ptr)
+
+withField :: (WithJava m) =>  Field -> (JFieldPtr -> m a) -> m a
+withField mp f=do
+        fid<-findField mp
+        when (fid==nullPtr) (liftIO $ ioError $ userError $ printf "field %s not found" $ show mp)
+        f fid
+
+withStaticField :: (WithJava m) =>  Field -> (JFieldPtr -> m a) -> m a
+withStaticField mp f=do
+        fid<-findStaticField mp
+        when (fid==nullPtr) (liftIO $ ioError $ userError $ printf "static field %s not found" $ show mp)
+        f fid
+
+handleException :: (CWString -> IO a) -> IO a
+handleException f=allocaBytes 1000 (\errMsg ->do
+        ret<-f errMsg
+        s<-peekCWString errMsg
+        when (not $ null s) (ioError $ userError s)
+        return ret
+        )
+
+withObject :: (WithJava m) => (m JObjectPtr) -> (JObjectPtr -> m a) -> m a
+withObject f1 f2=do
+        obj <- f1
+        ret <- f2 obj
+        liftIO $ f_freeObject obj
+        return (ret)
+
+newObject :: (WithJava m) => ClassName -> String -> [JValue] -> m (JObjectPtr) 
+newObject className signature args= withClass (className) (\cls->do
+        withMethod (Method className "<init>" signature) (\mid->
+                liftIO $ withArray args
+                        (\arr-> handleException $ f_newObject cls mid arr)))
+
+event :: JavaCache -> CallbackMapRef -> CallbackInternal
+event jc mvar _ _ index eventObj=do
+        putStrLn "event"
+        putStrLn ("listenerEvt:"++(show index))
+        mh<-liftIO $ withMVar mvar (\m->do
+                return $ Map.lookup index m
+                )
+        case mh of
+                Nothing-> return ()
+                Just h->evalStateT (h eventObj) jc    
+    
+        
+--instance MethodProvider (JClassPtr,String,String) where
+--        getMethodID (cls,method,signature)=do
+--            withCString method
+--                (\m->withCString signature
+--                        (\s->f_findMethod cls m s))
+--          
+--instance MethodProvider (String,String,String) where
+--        getMethodID (clsName,method,signature)=do
+--            findClass clsName>>=(\cls->do
+--                    when (cls==nullPtr) (ioError $ userError $ printf "class %s not found" clsName)
+--                    withCString method
+--                        (\m->withCString signature
+--                                (\s->f_findMethod cls m s)))
+--          
+
+
+
+          
+voidMethod :: (WithJava m) => JObjectPtr -> Method -> [JValue] -> m ()  
+voidMethod obj m args= 
+        withMethod m (\mid->liftIO $ withArray args (\arr->handleException $ f_callVoidMethod obj mid arr)) 
+
+execMethod :: (HaskellJavaConversion h j,WithJava m) => 
+        (JObjectPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO j)
+        -> JObjectPtr -> Method -> [JValue] -> m h
+execMethod f obj m args = javaToHaskell $ withMethod m (\mid->liftIO $ withArray args (\arr->handleException $ f obj mid arr))    
+
+booleanMethod :: (WithJava m) =>JObjectPtr -> Method -> [JValue] -> m (Bool)   
+booleanMethod obj m args= execMethod f_callBooleanMethod obj m args
+
+intMethod :: (WithJava m) =>JObjectPtr -> Method -> [JValue] -> m (Integer)   
+intMethod obj m args= execMethod f_callIntMethod obj m args
+
+charMethod :: (WithJava m) =>JObjectPtr -> Method -> [JValue] -> m (Char)   
+charMethod obj m args= execMethod f_callCharMethod obj m args
+
+shortMethod :: (WithJava m) =>JObjectPtr -> Method -> [JValue] -> m (Int)   
+shortMethod obj m args= execMethod f_callShortMethod obj m args
+
+byteMethod :: (WithJava m) =>JObjectPtr -> Method -> [JValue] -> m (Int)   
+byteMethod obj m args= execMethod f_callByteMethod obj m args
+  
+longMethod :: (WithJava m) =>JObjectPtr -> Method -> [JValue] -> m (Integer)   
+longMethod obj m args= execMethod f_callLongMethod obj m args
+        
+floatMethod :: (WithJava m) =>JObjectPtr -> Method -> [JValue] -> m (Float)   
+floatMethod obj m args= execMethod f_callFloatMethod obj m args   
+
+doubleMethod :: (WithJava m) =>JObjectPtr -> Method -> [JValue] -> m (Double)   
+doubleMethod obj m args= execMethod f_callDoubleMethod obj m args
+        
+objectMethod :: (WithJava m) =>JObjectPtr -> Method -> [JValue] -> m (JObjectPtr)   
+objectMethod obj m args= execMethod f_callObjectMethod obj m args
+
+execStaticMethod :: (HaskellJavaConversion h j,WithJava m) => 
+        (JClassPtr -> JMethodPtr -> JValuePtr  -> CWString-> IO j)
+        -> JClassPtr -> Method -> [JValue] -> m h
+execStaticMethod f cls m args = javaToHaskell $ withStaticMethod m (\mid->liftIO $ withArray args (\arr->handleException $ f cls mid arr)) 
+        
+staticIntMethod :: (WithJava m) =>JClassPtr -> Method -> [JValue] -> m (Integer)   
+staticIntMethod cls m args= execStaticMethod f_callStaticIntMethod cls m args
+
+staticBooleanMethod :: (WithJava m) =>JClassPtr -> Method -> [JValue] -> m (Bool)   
+staticBooleanMethod cls m args= execStaticMethod f_callStaticBooleanMethod cls m args
+
+staticCharMethod :: (WithJava m) =>JClassPtr -> Method -> [JValue] -> m (Char)   
+staticCharMethod cls m args= execStaticMethod f_callStaticCharMethod cls m args
+
+staticShortMethod :: (WithJava m) =>JClassPtr -> Method -> [JValue] -> m (Int)   
+staticShortMethod cls m args= execStaticMethod f_callStaticShortMethod cls m args
+
+staticByteMethod :: (WithJava m) =>JClassPtr -> Method -> [JValue] -> m (Int)   
+staticByteMethod cls m args= execStaticMethod f_callStaticByteMethod cls m args
+  
+staticLongMethod :: (WithJava m) =>JClassPtr -> Method -> [JValue] -> m (Integer)   
+staticLongMethod cls m args= execStaticMethod f_callStaticLongMethod cls m args
+        
+staticFloatMethod :: (WithJava m) =>JClassPtr -> Method -> [JValue] -> m (Float)   
+staticFloatMethod cls m args= execStaticMethod f_callStaticFloatMethod cls m args
+  
+staticDoubleMethod :: (WithJava m) =>JClassPtr -> Method -> [JValue] -> m (Double)   
+staticDoubleMethod cls m args= execStaticMethod f_callStaticDoubleMethod cls m args
+        
+staticObjectMethod :: (WithJava m) =>JClassPtr -> Method -> [JValue] -> m (JObjectPtr)   
+staticObjectMethod cls m args= execStaticMethod f_callStaticObjectMethod cls m args
+
+getStaticField :: (HaskellJavaConversion h j,WithJava m) => 
+        (JClassPtr -> JFieldPtr -> CWString-> IO j)
+        -> JClassPtr -> Field -> m h
+getStaticField f cls fi = javaToHaskell $ withStaticField fi (\fid->liftIO $ handleException $ f cls fid) 
+
+getStaticIntField :: (WithJava m) =>JClassPtr -> Field -> m (Integer)   
+getStaticIntField = getStaticField f_getStaticIntField 
+
+getStaticBooleanField :: (WithJava m) =>JClassPtr -> Field -> m (Bool)   
+getStaticBooleanField = getStaticField f_getStaticBooleanField 
+
+getStaticCharField :: (WithJava m) =>JClassPtr -> Field -> m (Char)   
+getStaticCharField = getStaticField f_getStaticCharField 
+
+getStaticShortField :: (WithJava m) =>JClassPtr -> Field -> m (Int)   
+getStaticShortField = getStaticField f_getStaticShortField 
+
+getStaticByteField :: (WithJava m) =>JClassPtr -> Field -> m (Int)   
+getStaticByteField= getStaticField f_getStaticByteField 
+
+getStaticLongField :: (WithJava m) =>JClassPtr -> Field -> m (Integer)   
+getStaticLongField = getStaticField f_getStaticLongField
+
+getStaticDoubleField :: (WithJava m) =>JClassPtr -> Field -> m (Double)   
+getStaticDoubleField= getStaticField f_getStaticDoubleField
+
+getStaticFloatField :: (WithJava m) =>JClassPtr -> Field -> m (Float)   
+getStaticFloatField= getStaticField f_getStaticFloatField
+
+getStaticObjectField :: (WithJava m) =>JClassPtr -> Field -> m (JObjectPtr)   
+getStaticObjectField= getStaticField f_getStaticObjectField
+
+setStaticField :: (HaskellJavaConversion h j,WithJava m) => 
+        (JClassPtr -> JFieldPtr -> j -> CWString  -> IO ())
+        -> JClassPtr -> Field -> h -> m ()
+setStaticField f cls fi v= withStaticField fi (\fid->liftIO $ handleException $ f cls fid $ fromHaskell v) 
+
+setStaticIntField :: (WithJava m) =>JClassPtr -> Field -> Integer -> m ()   
+setStaticIntField = setStaticField f_setStaticIntField
+
+setStaticBooleanField :: (WithJava m) =>JClassPtr -> Field -> Bool -> m ()   
+setStaticBooleanField = setStaticField f_setStaticBooleanField
+
+setStaticCharField :: (WithJava m) =>JClassPtr -> Field -> Char -> m ()   
+setStaticCharField = setStaticField f_setStaticCharField
+
+setStaticShortField :: (WithJava m) =>JClassPtr -> Field -> Int -> m ()   
+setStaticShortField = setStaticField f_setStaticShortField
+
+setStaticByteField :: (WithJava m) =>JClassPtr -> Field -> Int -> m ()   
+setStaticByteField = setStaticField f_setStaticByteField
+
+setStaticLongField :: (WithJava m) =>JClassPtr -> Field -> Integer -> m ()   
+setStaticLongField = setStaticField f_setStaticLongField
+
+setStaticDoubleField :: (WithJava m) =>JClassPtr -> Field -> Double -> m ()   
+setStaticDoubleField = setStaticField f_setStaticDoubleField
+
+setStaticFloatField :: (WithJava m) =>JClassPtr -> Field -> Float -> m ()   
+setStaticFloatField = setStaticField f_setStaticFloatField
+
+setStaticObjectField :: (WithJava m) =>JClassPtr -> Field -> JObjectPtr -> m ()   
+setStaticObjectField = setStaticField f_setStaticObjectField
+
+getField :: (HaskellJavaConversion h j,WithJava m) => 
+        (JObjectPtr -> JFieldPtr -> CWString-> IO j)
+        -> JObjectPtr -> Field -> m h
+getField f cls fi = javaToHaskell $ withField fi (\fid->liftIO $ handleException $ f cls fid) 
+
+getIntField :: (WithJava m) =>JObjectPtr -> Field -> m (Integer)   
+getIntField = getField f_getIntField 
+
+getBooleanField :: (WithJava m) =>JObjectPtr -> Field -> m (Bool)   
+getBooleanField = getField f_getBooleanField 
+
+getCharField :: (WithJava m) =>JObjectPtr -> Field -> m (Char)   
+getCharField = getField f_getCharField 
+
+getShortField :: (WithJava m) =>JObjectPtr -> Field -> m (Int)   
+getShortField = getField f_getShortField 
+
+getByteField :: (WithJava m) =>JObjectPtr -> Field -> m (Int)   
+getByteField= getField f_getByteField 
+
+getLongField :: (WithJava m) =>JObjectPtr -> Field -> m (Integer)   
+getLongField = getField f_getLongField
+
+getDoubleField :: (WithJava m) =>JObjectPtr -> Field -> m (Double)   
+getDoubleField= getField f_getDoubleField
+
+getFloatField :: (WithJava m) =>JObjectPtr -> Field -> m (Float)   
+getFloatField= getField f_getFloatField
+
+getObjectField :: (WithJava m) =>JObjectPtr -> Field -> m (JObjectPtr)   
+getObjectField= getField f_getObjectField
+
+setField :: (HaskellJavaConversion h j,WithJava m) => 
+        (JObjectPtr -> JFieldPtr -> j -> CWString  -> IO ())
+        -> JObjectPtr -> Field -> h -> m ()
+setField f cls fi v= withField fi (\fid->liftIO $ handleException $ f cls fid $ fromHaskell v) 
+
+setIntField :: (WithJava m) =>JObjectPtr -> Field -> Integer -> m ()   
+setIntField = setField f_setIntField
+
+setBooleanField :: (WithJava m) =>JObjectPtr -> Field -> Bool -> m ()   
+setBooleanField = setField f_setBooleanField
+
+setCharField :: (WithJava m) =>JObjectPtr -> Field -> Char -> m ()   
+setCharField = setField f_setCharField
+
+setShortField :: (WithJava m) =>JObjectPtr -> Field -> Int -> m ()   
+setShortField = setField f_setShortField
+
+setByteField :: (WithJava m) =>JObjectPtr -> Field -> Int -> m ()   
+setByteField = setField f_setByteField
+
+setLongField :: (WithJava m) =>JObjectPtr -> Field -> Integer -> m ()   
+setLongField = setField f_setLongField
+
+setDoubleField :: (WithJava m) =>JObjectPtr -> Field -> Double -> m ()   
+setDoubleField = setField f_setDoubleField
+
+setFloatField :: (WithJava m) =>JObjectPtr -> Field -> Float -> m ()   
+setFloatField = setField f_setFloatField
+
+setObjectField :: (WithJava m) =>JObjectPtr -> Field -> JObjectPtr -> m ()   
+setObjectField = setField f_setObjectField
+
+
+
+toJString :: (MonadIO m) => String -> m (JObjectPtr) 
+toJString s=  liftIO $ withCWString s (\cs->handleException $ f_newString cs (fromIntegral $ length s))
+ src/Language/Java/JVM/Generator.hs view
@@ -0,0 +1,141 @@+
+module Language.Java.JVM.Generator where
+
+import Language.Java.JVM.JavapParser
+import Language.Java.JVM.SignatureParser
+
+import Control.Monad.Identity
+import Control.Monad.State
+
+import Data.Char (toUpper)
+import Data.List (foldl')
+import qualified Data.Set as Set
+
+import Language.Haskell.Exts.Syntax
+import Text.Parsec
+import System.Info
+import System.FilePath
+import System.Process
+
+
+addExeExtension :: FilePath -> String
+addExeExtension fn= case os of
+        "mingw32"->addExtension fn "exe"
+        "cygwin32"->addExtension fn "exe"
+        "win32"->addExtension fn "exe"
+        _->fn     
+
+runJavap :: FilePath -> String -> IO(String)
+runJavap javaHome className=do
+        let javapPath=javaHome </> "bin" </> (addExeExtension "javap")
+        s<-readProcess javapPath ["-s",className] ""
+        let l=lines s
+        case l of
+                (_:xs)-> return $ unlines xs
+                _ -> return ""
+
+parseClass :: FilePath -> String -> IO (Either ParseError TypeDecl)
+parseClass javaHome className=do
+        contents<-runJavap javaHome className
+        return $ parseTypeDecl contents
+        
+generate :: TypeDecl -> (Module,FilePath)
+generate td=let
+        cls=td_name td
+        moduleName=map toMod (zip [0..] cls)
+        fp=addExtension moduleName "hs"
+        decls=concat $ runIdentity $ evalStateT (mapM (generateDecl cls) (td_decls td)) ((SrcLoc fp 6 1),Set.empty)
+        impTypes=ImportDecl (SrcLoc fp 3 1) (ModuleName "Language.Java.JVM.Types") False False Nothing Nothing Nothing
+        impAPI=ImportDecl (SrcLoc fp 3 1) (ModuleName "Language.Java.JVM.API") False False Nothing Nothing Nothing
+        in (Module (SrcLoc fp 2 1) (ModuleName ("Language.Java.JVM.Bindings."++moduleName)) [LanguagePragma (SrcLoc fp 1 1) [Ident "RankNTypes"]] Nothing Nothing [impTypes,impAPI] decls,fp)
+        where 
+                toMod (_,'/')='_'
+                toMod (0,a)=toUpper a
+                toMod (_,a)=a
+                
+generateDecl :: String -> JDecl -> SrcLocT [Decl]
+generateDecl cls (JMethodDecl name signature static)=do
+                slTyp<-srcLoc
+                slFun<-srcLoc
+                id<-identName name
+                let 
+                    Right (JSignature params ret)=parseSignature signature
+                    (exp,ret')=if name=="<init>" 
+                        then
+                               (App (App (Var (UnQual (Ident "newObject"))) (Lit $ String cls)) (Lit $ String signature),Just "JObj")
+                        else 
+                               let  
+                                        methoddef=App (App (App (Con (UnQual (Ident "Method"))) (Lit $ String cls)) (Lit $ String name)) (Lit $ String signature)
+                                        methodInvocation=Var (UnQual (Ident $ wrapperToMethod ret))
+                                        obj=Var (UnQual (Ident "obj"))
+                               in (App (App methodInvocation obj) methoddef,ret)        
+                    pats=zipWith (\_ idx->PVar $ Ident ("p"++(show idx))) params [0..]
+                    patsWithObj=if name /= "<init>" && (not static)
+                        then ((PVar $ Ident "obj") : pats)
+                        else pats
+                    parms=zipWith (\w idx->App (Var $ UnQual $ Ident w) $ cast w (Var $ UnQual $ Ident ("p"++(show idx)))) params [0..]
+                    rhs=UnGuardedRhs $ App exp $ List parms
+                    m0=Match slFun (Ident id) patsWithObj Nothing rhs (BDecls [])
+                    retType=TyApp (TyVar $ Ident "m") (TyVar $ Ident $ wrapperToUnwrapped ret')
+                    paramType=foldl' (\t p->(TyFun (TyVar $ Ident $ wrapperToUnwrapped $ Just p) t)) retType params
+                    objType=if name=="<init>" 
+                        then paramType
+                        else (TyFun (TyVar $ Ident "JObjectPtr") paramType)
+                    typ=TyForall Nothing [ClassA (UnQual $ Ident "WithJava") [(TyVar $ Ident "m")]] objType
+                    sig=TypeSig slFun [Ident id] typ
+                return $ [sig,FunBind [m0]]
+generateDecl cls (JFieldDecl name signature static)=undefined
+
+type SrcLocT=StateT GenState Identity
+
+type GenState=(SrcLoc,Set.Set String)
+
+srcLoc :: SrcLocT SrcLoc
+srcLoc= do
+        sl<-gets fst
+        modify (\((SrcLoc fp l c),g)->(SrcLoc fp (l+1) c,g))
+        return sl
+
+identName:: String -> SrcLocT String
+identName n=do
+        names<-gets snd
+        let
+                n'=if n=="<init>"
+                        then "new"
+                        else n
+                possibleNames=[n'] ++ (map (\idx->(n')++(show idx)) [1..])
+                okNames=filter (\pn->Set.notMember pn names) possibleNames
+                firstOK=head okNames
+        modify (\(s,ns)->(s,Set.insert firstOK ns))
+        return firstOK
+
+cast :: String -> Exp -> Exp
+cast "JLong"= App (Var $ UnQual $ Ident "fromIntegral")
+cast "JInt"= App (Var $ UnQual $ Ident "fromIntegral")
+cast _=id
+
+wrapperToUnwrapped :: Maybe String -> String
+wrapperToUnwrapped (Just "JObj")="JObjectPtr"
+wrapperToUnwrapped (Just "JInt")="Integer"
+wrapperToUnwrapped (Just "JBool")="Bool"
+wrapperToUnwrapped (Just "JByte")="Int"
+wrapperToUnwrapped (Just "JChar")="Char"
+wrapperToUnwrapped (Just "JShort")="Int"
+wrapperToUnwrapped (Just "JLong")="Integer"
+wrapperToUnwrapped (Just "JFloat")="Float"
+wrapperToUnwrapped (Just "JDouble")="Double"
+wrapperToUnwrapped Nothing="()"
+wrapperToUnwrapped (Just a)=error ("undefined wrapper"++a)
+
+wrapperToMethod :: Maybe String -> String
+wrapperToMethod (Just "JObj")="objectMethod"
+wrapperToMethod (Just "JInt")="intMethod"
+wrapperToMethod (Just "JBool")="booleanMethod"
+wrapperToMethod (Just "JByte")="byteMethod"
+wrapperToMethod (Just "JChar")="charMethod"
+wrapperToMethod (Just "JShort")="shortMethod"
+wrapperToMethod (Just "JLong")="longMethod"
+wrapperToMethod (Just "JFloat")="floatMethod"
+wrapperToMethod (Just "JDouble")="doubleMethod"
+wrapperToMethod Nothing="voidMethod"
+wrapperToMethod (Just a)=error ("undefined wrapper"++a)
+ src/Language/Java/JVM/JavapParser.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE RankNTypes #-}
+
+module Language.Java.JVM.JavapParser where
+
+import Language.Java.JVM.Types
+
+import Control.Monad
+import Data.Functor.Identity
+import Data.List
+import Data.Maybe
+
+import Text.Parsec
+import qualified Text.Parsec.Token as P
+import Text.Parsec.Language (javaStyle)
+
+  
+data TypeDecl=TypeDecl {
+        td_name::ClassName
+        ,td_supers::[ClassName]
+        ,td_decls::[JDecl]
+        }
+        deriving (Show,Read,Eq,Ord)
+
+data JDecl=JMethodDecl {
+        d_name::String
+        ,d_signature::String
+        ,d_static::Bool
+        }
+        | JFieldDecl {
+        d_name::String
+        ,d_signature::String
+        ,d_static::Bool
+        }
+        deriving (Show,Read,Eq,Ord)
+       
+parseTypeDecl :: String -> Either ParseError TypeDecl
+parseTypeDecl contents= parse typeDecl "unknown" contents
+
+typeDecl ::ParsecT String u Identity TypeDecl
+typeDecl=do
+        modifiers
+        choice [symbol "class",symbol "interface"]
+        name<-className
+        extends<-optionMaybe (do
+                symbol "extends"
+                classList
+                )  
+        implements<-optionMaybe (do
+                symbol "implements"
+                classList
+                ) 
+        decls<-braces (do
+                decls<-many $ decl
+                return $ catMaybes decls)
+        return $ TypeDecl name (concat $ catMaybes [extends,implements]) decls
+
+decl :: ParsecT String u Identity (Maybe JDecl)
+decl = do
+        sta<-static
+        choice [(do
+                staticBlock
+                return Nothing)
+                ,(do
+                        className
+                        (name,meth)<-choice [(do
+                                parens (classList0)
+                                return ("<init>",True)
+                                ),
+                                (do
+                                name <-identifier
+                                p<-optionMaybe $ parens (classList0)
+                                return (name,isJust p)
+                                )
+                                ]
+                        when meth (optional (do
+                                symbol "throws"
+                                classList
+                                ))
+                        semi        
+                        sign<-signature
+                        return $ if meth
+                                then Just $ JMethodDecl name sign sta
+                                else Just $ JFieldDecl name sign sta
+                )]
+
+--methodDecl :: ParsecT String u Identity (Bool -> Decl)
+--methodDecl=do
+--        className
+--        name<-choice [(do
+--                parens (classList0)
+--                return "<init>"
+--                ),
+--                (do
+--                name <-identifier
+--                parens (classList0)
+--                return name
+--                )
+--                ]
+--        optional (do
+--                symbol "throws"
+--                classList
+--                )
+--        semi        
+--        sign<-signature
+--        return $ MethodDecl name sign
+--         
+--fieldDecl :: ParsecT String u Identity (Bool -> Decl)
+--fieldDecl=do
+--        className
+--        name<-identifier
+--        semi        
+--        sign<-signature
+--        return $ FieldDecl name sign         
+         
+signature :: ParsecT String u Identity String
+signature=do
+        symbol "Signature"
+        colon
+        manyTill anyToken (try (newline))
+               
+staticBlock :: ParsecT String u Identity ()
+staticBlock=do
+        braces whiteSpace
+        semi
+        signature
+        return ()
+
+classList :: ParsecT String u Identity [ClassName]
+classList=sepBy1 className comma
+
+classList0 :: ParsecT String u Identity [ClassName]
+classList0=sepBy className comma
+
+className ::ParsecT String u Identity ClassName
+className = do
+      names<-sepBy1 identifier dot  
+      optionMaybe $ brackets whiteSpace
+      return $ intercalate "/" names
+
+static :: ParsecT String u Identity Bool
+static = do
+        mds<-modifiers
+        return $ elem "static" mds
+
+modifiers ::ParsecT String u Identity [String]
+modifiers = many $ try $ choice [
+        try $ symbol "public"
+        ,try $ symbol "protected"
+        ,symbol "private"
+        ,symbol "static"
+        ,symbol "volatile"
+        ,symbol "transient"
+        ,symbol "final"
+        ,symbol "native"]
+
+lexer ::P.GenTokenParser String u Identity
+lexer=P.makeTokenParser javaStyle  
+
+parens :: ParsecT String u Identity a -> ParsecT String u Identity a  
+parens      = P.parens lexer
+braces ::  ParsecT String u Identity a -> ParsecT String u Identity a  
+braces      = P.braces lexer
+brackets ::  ParsecT String u Identity a -> ParsecT String u Identity a  
+brackets      = P.brackets lexer
+
+identifier :: ParsecT String u Identity String
+identifier  = P.identifier lexer
+
+symbol :: String -> ParsecT String u Identity String
+symbol      = P.symbol lexer
+
+dot :: ParsecT String u Identity String
+dot         = P.dot lexer
+
+comma :: ParsecT String u Identity String
+comma       = P.comma lexer
+
+colon :: ParsecT String u Identity String
+colon       = P.colon lexer
+
+semi :: ParsecT String u Identity String
+semi        = P.semi lexer
+
+whiteSpace :: ParsecT String u Identity ()
+whiteSpace  = P.whiteSpace lexer
+ src/Language/Java/JVM/SignatureParser.hs view
@@ -0,0 +1,61 @@+
+module Language.Java.JVM.SignatureParser where
+
+import Data.Functor.Identity
+import Text.Parsec
+
+
+data JSignature=JSignature [String] (Maybe String)
+        deriving (Read,Show,Eq,Ord)
+
+parseSignature :: String -> Either ParseError JSignature
+parseSignature contents= parse signature "unknown" contents
+
+signature :: ParsecT String u Identity JSignature
+signature = do
+        char '('
+        params<-many typeSignature
+        char ')'
+        ret<-choice [(do
+                t<-typeSignature
+                return $ Just t),(do
+                char 'V'
+                return Nothing)]
+        return $ JSignature params ret
+        
+typeSignature :: ParsecT String u Identity String
+typeSignature = choice [(do
+                char '['
+                ts<-typeSignature
+                return "JObj"
+                --return (ts++"[]")
+                
+        ),(do
+                char 'L'
+                manyTill (anyChar) (try $ char ';')
+                return "JObj")
+        ,(do
+                char 'I'
+                return "JInt")
+        ,(do
+                char 'S'
+                return "JShort")
+        ,(do
+                char 'Z'
+                return "JBool")
+        ,(do
+                char 'B'
+                return "JByte")
+        ,(do
+                char 'D'
+                return "JDouble")
+        ,(do
+                char 'F'
+                return "JFloat")
+        ,(do
+                char 'C'
+                return "JChar")
+        ,(do
+                char 'J'
+                return "JLong")
+        ]
+ src/Language/Java/JVM/Types.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, TypeSynonymInstances, RankNTypes, ImpredicativeTypes, MultiParamTypeClasses #-}
+
+module Language.Java.JVM.Types where
+
+import qualified Data.Map as Map
+import Foreign.C
+import Foreign.Ptr
+import Foreign.Storable
+import Data.Map (Map)
+import Control.Concurrent.MVar
+import Control.Monad.State
+
+data JObject
+type JObjectPtr=Ptr JObject
+data JClass
+type JClassPtr=Ptr JClass
+data JMethod
+type JMethodPtr=Ptr JMethod
+data JField
+type JFieldPtr=Ptr JField
+--data JRuntime
+--type JRuntimePtr=Ptr JRuntime
+
+newtype TypedJObjectPtr a=TypedJObjectPtr JObjectPtr
+        deriving (Eq,Show)
+        
+data JEnv
+type JEnvPtr=Ptr JEnv
+
+type CallbackInternal=(JEnvPtr -> JObjectPtr -> CLong -> JObjectPtr -> IO())
+
+type Callback = (JObjectPtr -> JavaT ())
+
+type CallbackMap = Map.Map CLong Callback
+type CallbackMapRef =MVar CallbackMap
+
+data JValue=JObj JObjectPtr
+        | JInt CLong
+        | JBool CUChar
+        | JByte CChar
+        | JChar CUShort
+        | JShort CShort
+        | JLong CLong
+        | JFloat CFloat
+        | JDouble CDouble
+
+type JValuePtr=Ptr JValue
+
+instance Storable JValue where
+        sizeOf _= 8
+        alignment _=alignment (undefined :: CDouble)
+        poke p (JObj l)= poke (castPtr p) l
+        poke p (JInt i)= poke (castPtr p) i
+        poke p (JBool z)= poke (castPtr p) z
+        poke p (JByte b)= poke (castPtr p) b
+        poke p (JChar c)= poke (castPtr p) c
+        poke p (JShort s)= poke (castPtr p) s
+        poke p (JLong j)= poke (castPtr p) j
+        poke p (JFloat f)= poke (castPtr p) f
+        poke p (JDouble d)= poke (castPtr p) d
+        peek=error "undefined peek"
+
+--class MethodProvider a where
+--        getMethodID :: a -> IO (JMethodPtr)
+
+--instance MethodProvider JMethodPtr where
+--        getMethodID=return
+
+type ClassName = String
+
+data Method = Method {
+        m_class::ClassName
+        ,m_name:: String
+        ,m_signature:: String
+        }
+        deriving (Read,Show,Eq,Ord)
+
+data Field= Field {
+        f_class::ClassName
+        ,f_name:: String
+        ,f_signature:: String
+        }
+        deriving (Read,Show,Eq,Ord)
+        
+type ClassCache=Map ClassName JClassPtr
+type MethodCache=Map Method JMethodPtr
+type FieldCache=Map Field JFieldPtr
+        
+data JavaCache=JavaCache {
+        jc_classes::ClassCache
+        ,jc_methods::MethodCache
+        ,jc_fields::FieldCache
+        }        
+        
+type JavaT =StateT JavaCache IO
+     
+class (Monad m, MonadIO m) => WithJava m where
+        getJavaCache  :: m JavaCache
+        putJavaCache  :: JavaCache -> m()
+        
+instance WithJava JavaT where
+        getJavaCache = do
+                rt<-get
+                return rt
+        putJavaCache=put
+
+javaToHaskell :: (HaskellJavaConversion h j,WithJava m)=> m j -> m h
+javaToHaskell = liftM toHaskell
+
+haskellToJava :: (HaskellJavaConversion h j,WithJava m)=> m h -> m j
+haskellToJava = liftM fromHaskell
+        
+class HaskellJavaConversion h j where
+        toHaskell :: j -> h
+        fromHaskell :: h -> j
+        
+instance HaskellJavaConversion Float CFloat where
+        toHaskell = realToFrac
+        fromHaskell = realToFrac
+        
+instance HaskellJavaConversion Double CDouble where
+        toHaskell = realToFrac
+        fromHaskell = realToFrac
+                
+instance HaskellJavaConversion Integer CLong where
+        toHaskell = fromIntegral
+        fromHaskell = fromIntegral
+        
+instance HaskellJavaConversion Int CChar where
+        toHaskell = fromIntegral  
+        fromHaskell = fromIntegral        
+        
+instance HaskellJavaConversion Int CShort where
+        toHaskell = fromIntegral  
+        fromHaskell = fromIntegral  
+
+instance HaskellJavaConversion Bool CUChar where
+        toHaskell = (0 /=)   
+        fromHaskell True = 1
+        fromHaskell False = 0   
+
+instance HaskellJavaConversion Char CUShort where
+        toHaskell = toEnum . fromIntegral
+        fromHaskell = fromIntegral . fromEnum
+
+instance HaskellJavaConversion JObjectPtr JObjectPtr where
+        toHaskell = id    
+        fromHaskell = id    
+
+ src/Language/Java/JVM/hjvm.c view
@@ -0,0 +1,655 @@+#include <jni.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "hjvm.h"
+
+/*eventCallback *eventCb;
+
+void event(JNIEnv *env, jobject listener,jint index,jobject event){
+	eventCb(index,event);
+}*/
+
+JavaVM *getJVM(){
+	JavaVM *jvm;
+	jsize vmnb;
+	JNI_GetCreatedJavaVMs(&jvm,1,&vmnb);
+	return jvm;
+}
+
+JNIEnv* getEnv(JavaVM *jvm){
+	JNIEnv *env;
+	(*jvm)->AttachCurrentThread(jvm,(void**)&env,NULL);
+	return env;
+}
+
+jint start(char* classpath){
+     jint res;
+     JNIEnv *env;
+     JavaVM *jvm;
+     JavaVMInitArgs vm_args;
+     JavaVMOption options[1];
+     jsize vmnb;
+     //runtime rt=(runtime)malloc(sizeof(runtime*));
+     //jclass nativeListener;
+     res = JNI_GetCreatedJavaVMs(&jvm,1,&vmnb);
+     if (res<0){
+    	 return res;
+     }
+     if (vmnb<1){
+
+		 options[0].optionString =classpath;
+		 vm_args.version = JNI_VERSION_1_4; //0x00010002;
+		 vm_args.options = options;
+		 vm_args.nOptions = 1;
+		 vm_args.ignoreUnrecognized = JNI_TRUE;
+		 /* Create the Java VM */
+		 return JNI_CreateJavaVM(&jvm, (void**)&env, &vm_args);
+     }
+//	 if (res<0){
+//		 return NULL;
+//	 }
+	// rt->env=env;
+	// rt->jvm=jvm;
+	// eventCb=f;
+
+	// nativeListener=findClass(rt,"Language/Java/SWT/NativeListener");
+	// (*env)->RegisterNatives(env,nativeListener, methods, 1);
+
+
+	 return 0;
+}
+
+void registerCallback(const char *clsName,const char *methodName,const char *eventClsName,eventCallback f){
+	int length=3+(strlen(eventClsName))+3;
+	char *signature;
+	jclass cls;
+	JNINativeMethod methods[1] ;
+	JNINativeMethod* m=malloc(sizeof(JNINativeMethod));
+	char *methodcpy=(char *)malloc(sizeof(char) * (strlen(methodName)+1));
+	JNIEnv *env=getEnv(getJVM());
+	cls=findClass(clsName);
+
+	methodcpy=
+	strcpy(methodcpy,methodName);
+
+	signature = (char *)malloc(sizeof(char) * (length+1));
+	strcpy(signature,"(IL");
+	strcat(signature,eventClsName);
+	strcat(signature,";)V");
+
+	m->name= methodcpy;
+	m->signature= signature;
+	m->fnPtr= f;
+	methods[0]=*m;
+
+	(*env)->RegisterNatives(env, cls,methods,1);
+
+	free(m);
+	free(methodcpy);
+	free(signature);
+}
+
+void end(){
+	JavaVM* jvm=getJVM();
+	(*jvm)->DestroyJavaVM(jvm);
+//	free(rt->env);
+//	free(rt);
+}
+
+jclass findClass(const char *name){
+	JNIEnv *env=getEnv(getJVM());
+	jclass local=(*env)->FindClass(env, name);
+	jclass global=(*env)->NewGlobalRef(env, local);
+	(*env)->DeleteLocalRef(env, local);
+	return global;
+}
+
+void freeClass(jclass global){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)->DeleteGlobalRef(env, global);
+}
+
+void freeObject(jobject global){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)->DeleteGlobalRef(env, global);
+}
+
+jmethodID findMethod(const jclass cls,const char *method,const char *signature){
+	JNIEnv *env=getEnv(getJVM());
+	jmethodID mid;
+	mid=(*env)->GetMethodID(env, cls, method,
+			 signature);
+	(*env)->ExceptionClear(env);
+	return mid;
+}
+
+jfieldID findField(const jclass cls,const char *name,const char *signature){
+	JNIEnv *env=getEnv(getJVM());
+	jfieldID fid;
+	fid=(*env)->GetFieldID(env, cls, name,
+			 signature);
+	(*env)->ExceptionClear(env);
+	return fid;
+}
+
+jfieldID findStaticField(const jclass cls,const char *name,const char *signature){
+	JNIEnv *env=getEnv(getJVM());
+	jfieldID fid;
+	fid=(*env)->GetStaticFieldID(env, cls, name,
+			 signature);
+	(*env)->ExceptionClear(env);
+	return fid;
+}
+
+jmethodID findStaticMethod(const jclass cls,const char *method,const char *signature){
+	JNIEnv *env=getEnv(getJVM());
+	jmethodID mid;
+	mid=(*env)->GetStaticMethodID(env, cls, method,
+			 signature);
+	(*env)->ExceptionClear(env);
+	return mid;
+}
+
+void handleException(JNIEnv *env,jchar *error){
+	jclass cls;
+	jmethodID mid;
+	jvalue args[0];
+	jobject msgO;
+	jthrowable exc = (*env)->ExceptionOccurred(env);
+	jboolean isCopy;
+	const jchar* msg;
+	if (exc) {
+		cls=findClass("java/lang/Throwable");
+		mid=findMethod(cls,"getLocalizedMessage","()Ljava/lang/String;");
+		msgO=(*env)->CallObjectMethodA (env,exc,mid,args);
+		msg=(*env)->GetStringChars(env,msgO,&isCopy);
+		while(*msg != 0) {
+			*error++ = *msg++;
+		}
+		*error =0;
+		(*env)->ExceptionClear(env);
+	} else {
+		*error=0;
+	}
+}
+
+jobject newObject(const jclass cls, const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+    if (cls == NULL || method== NULL) {
+         return NULL;
+    }
+    jobject local=(*env)->NewObjectA(env,cls,method,args);
+    handleException(env,error);
+	jobject global=(*env)->NewGlobalRef(env, local);
+	(*env)->DeleteLocalRef(env, local);
+	return global;
+}
+
+
+/*jmethodID getMethodID(JNIEnv *env,const jobject obj,const char *method,const char *signature){
+	jclass cls;
+	jmethodID mid;
+	if (obj==NULL){
+		return NULL;
+	}
+	cls=(*env)->GetObjectClass(env, obj);
+	if (cls==NULL){
+		return NULL;
+	}
+	mid = (*env)->GetMethodID(env, cls, method,
+										 signature);
+	return mid;
+}*/
+
+jint callIntMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jint ret=(*env)-> CallIntMethodA (env,obj,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jchar callCharMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jchar ret=(*env)-> CallCharMethodA (env,obj,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jshort callShortMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jmethodID mid;
+	jshort ret=(*env)-> CallShortMethodA (env,obj,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jbyte callByteMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jmethodID mid;
+	jbyte ret=(*env)-> CallByteMethodA (env,obj,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jlong callLongMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jlong ret=(*env)-> CallLongMethodA (env,obj,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jfloat callFloatMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jfloat ret=(*env)-> CallFloatMethodA (env,obj,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jdouble callDoubleMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jdouble ret=(*env)-> CallDoubleMethodA (env,obj,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jboolean callBooleanMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jboolean ret=(*env)-> CallBooleanMethodA (env,obj,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+void callVoidMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> CallVoidMethodA (env,obj,method,args);
+	handleException(env,error);
+}
+
+jobject callObjectMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jobject local=(*env)-> CallObjectMethodA (env,obj,method,args);
+	handleException(env,error);
+	jobject global=(*env)->NewGlobalRef(env, local);
+	(*env)->DeleteLocalRef(env, local);
+	return global;
+}
+
+jint callStaticIntMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jint ret=(*env)-> CallStaticIntMethodA (env,cls,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jchar callStaticCharMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jchar ret=(*env)-> CallStaticCharMethodA (env,cls,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jshort callStaticShortMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jmethodID mid;
+	jshort ret=(*env)-> CallStaticShortMethodA (env,cls,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jbyte callStaticByteMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jmethodID mid;
+	jbyte ret=(*env)-> CallStaticByteMethodA (env,cls,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jlong callStaticLongMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jlong ret=(*env)-> CallStaticLongMethodA (env,cls,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jfloat callStaticFloatMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jfloat ret=(*env)-> CallStaticFloatMethodA (env,cls,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jdouble callStaticDoubleMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jdouble ret=(*env)-> CallStaticDoubleMethodA (env,cls,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+jboolean callStaticBooleanMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jboolean ret=(*env)-> CallStaticBooleanMethodA (env,cls,method,args);
+	handleException(env,error);
+	return ret;
+}
+
+void callStaticVoidMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> CallStaticVoidMethodA (env,cls,method,args);
+	handleException(env,error);
+}
+
+jobject callStaticObjectMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jobject local=(*env)-> CallStaticObjectMethodA (env,cls,method,args);
+	handleException(env,error);
+	jobject global=(*env)->NewGlobalRef(env, local);
+	(*env)->DeleteLocalRef(env, local);
+	return global;
+}
+
+jstring newString(const jchar *unicode, jsize len,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jstring local=(*env)->NewString(env,unicode,len);
+	handleException(env,error);
+	jstring global=(*env)->NewGlobalRef(env, local);
+	(*env)->DeleteLocalRef(env, local);
+	return global;
+}
+
+jint getStaticIntField(const jclass cls,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jint ret=(*env)-> GetStaticIntField (env,cls,field);
+	handleException(env,error);
+	return ret;
+}
+
+jboolean getStaticBooleanField(const jclass cls,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jboolean ret=(*env)-> GetStaticBooleanField (env,cls,field);
+	handleException(env,error);
+	return ret;
+}
+
+jchar getStaticCharField(const jclass cls,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jchar ret=(*env)-> GetStaticCharField (env,cls,field);
+	handleException(env,error);
+	return ret;
+}
+
+jshort getStaticShortField(const jclass cls,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jshort ret=(*env)-> GetStaticShortField (env,cls,field);
+	handleException(env,error);
+	return ret;
+}
+
+jbyte getStaticByteField(const jclass cls,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jbyte ret=(*env)-> GetStaticByteField (env,cls,field);
+	handleException(env,error);
+	return ret;
+}
+
+jlong getStaticLongField(const jclass cls,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jlong ret=(*env)-> GetStaticLongField (env,cls,field);
+	handleException(env,error);
+	return ret;
+}
+
+jdouble getStaticDoubleField(const jclass cls,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jdouble ret=(*env)-> GetStaticDoubleField (env,cls,field);
+	handleException(env,error);
+	return ret;
+}
+
+jfloat getStaticFloatField(const jclass cls,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jfloat ret=(*env)-> GetStaticFloatField (env,cls,field);
+	handleException(env,error);
+	return ret;
+}
+
+jobject getStaticObjectField(const jclass cls,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jobject local=(*env)-> GetStaticObjectField (env,cls,field);
+	handleException(env,error);
+	jobject global=(*env)->NewGlobalRef(env, local);
+	(*env)->DeleteLocalRef(env, local);
+	return global;
+}
+
+void setStaticIntField(const jclass cls,const jfieldID field,jint val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetStaticIntField (env,cls,field,val);
+	handleException(env,error);
+}
+
+void setStaticBooleanField(const jclass cls,const jfieldID field,jboolean val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetStaticBooleanField (env,cls,field,val);
+	handleException(env,error);
+}
+
+void setStaticCharField(const jclass cls,const jfieldID field,jchar val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetStaticCharField (env,cls,field,val);
+	handleException(env,error);
+}
+
+void setStaticShortField(const jclass cls,const jfieldID field,jshort val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetStaticShortField (env,cls,field,val);
+	handleException(env,error);
+}
+
+void setStaticByteField(const jclass cls,const jfieldID field,jbyte val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetStaticByteField (env,cls,field,val);
+	handleException(env,error);
+}
+
+void setStaticLongField(const jclass cls,const jfieldID field,jlong val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetStaticLongField (env,cls,field,val);
+	handleException(env,error);
+}
+
+void setStaticDoubleField(const jclass cls,const jfieldID field,jdouble val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetStaticDoubleField (env,cls,field,val);
+	handleException(env,error);
+}
+
+void setStaticFloatField(const jclass cls,const jfieldID field,jfloat val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetStaticFloatField (env,cls,field,val);
+	handleException(env,error);
+}
+
+void setStaticObjectField(const jclass cls,const jfieldID field,jobject val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetStaticObjectField (env,cls,field,val);
+	handleException(env,error);
+}
+
+jint getIntField(const jobject obj,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jint ret=(*env)-> GetIntField (env,obj,field);
+	handleException(env,error);
+	return ret;
+}
+
+jboolean getBooleanField(const jobject obj,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jboolean ret=(*env)-> GetBooleanField (env,obj,field);
+	handleException(env,error);
+	return ret;
+}
+
+jchar getCharField(const jobject obj,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jchar ret=(*env)-> GetCharField (env,obj,field);
+	handleException(env,error);
+	return ret;
+}
+
+jshort getShortField(const jobject obj,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jshort ret=(*env)-> GetShortField (env,obj,field);
+	handleException(env,error);
+	return ret;
+}
+
+jbyte getByteField(const jobject obj,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jbyte ret=(*env)-> GetByteField (env,obj,field);
+	handleException(env,error);
+	return ret;
+}
+
+jlong getLongField(const jobject obj,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jlong ret=(*env)-> GetLongField (env,obj,field);
+	handleException(env,error);
+	return ret;
+}
+
+jdouble getDoubleField(const jobject obj,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jdouble ret=(*env)-> GetDoubleField (env,obj,field);
+	handleException(env,error);
+	return ret;
+}
+
+jfloat getFloatField(const jobject obj,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jfloat ret=(*env)-> GetFloatField (env,obj,field);
+	handleException(env,error);
+	return ret;
+}
+
+jobject getObjectField(const jobject obj,const jfieldID field,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	jobject local=(*env)-> GetObjectField (env,obj,field);
+	handleException(env,error);
+	jobject global=(*env)->NewGlobalRef(env, local);
+	(*env)->DeleteLocalRef(env, local);
+	return global;
+}
+
+void setIntField(const jobject obj,const jfieldID field,jint val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetIntField (env,obj,field,val);
+	handleException(env,error);
+}
+
+void setBooleanField(const jobject obj,const jfieldID field,jboolean val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetBooleanField (env,obj,field,val);
+	handleException(env,error);
+}
+
+void setCharField(const jobject obj,const jfieldID field,jchar val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetCharField (env,obj,field,val);
+	handleException(env,error);
+}
+
+void setShortField(const jobject obj,const jfieldID field,jshort val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetShortField (env,obj,field,val);
+	handleException(env,error);
+}
+
+void setByteField(const jobject obj,const jfieldID field,jbyte val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetByteField (env,obj,field,val);
+	handleException(env,error);
+}
+
+void setLongField(const jobject obj,const jfieldID field,jlong val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetLongField (env,obj,field,val);
+	handleException(env,error);
+}
+
+void setDoubleField(const jobject obj,const jfieldID field,jdouble val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetDoubleField (env,obj,field,val);
+	handleException(env,error);
+}
+
+void setFloatField(const jobject obj,const jfieldID field,jfloat val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetFloatField (env,obj,field,val);
+	handleException(env,error);
+}
+
+void setObjectField(const jobject obj,const jfieldID field,jobject val,jchar *error){
+	JNIEnv *env=getEnv(getJVM());
+	(*env)-> SetObjectField (env,obj,field,val);
+	handleException(env,error);
+}
+
+
+/*
+int test(int jvmid){
+	 jclass cls;
+     jmethodID mid;
+     jstring jstr;
+     jclass stringClass;
+     jobjectArray args;
+  
+     cls = (*env)->FindClass(env, "Prog");
+     if (cls == NULL) {
+         return -1;
+     }
+ 
+     mid = (*env)->GetStaticMethodID(env, cls, "main",
+                                     "([Ljava/lang/String;)V");
+     if (mid == NULL) {
+         return -2;
+     }
+     jstr = (*env)->NewStringUTF(env, "from C and Haskell!");
+     if (jstr == NULL) {
+        return -3;
+     }
+     stringClass = (*env)->FindClass(env, "java/lang/String");
+     args = (*env)->NewObjectArray(env, 1, stringClass, jstr);
+     if (args == NULL) {
+         return -4;
+     }
+     (*env)->CallStaticVoidMethod(env, cls, mid, args);
+	 return 0;
+}
+
+long create(){
+	jclass cls;
+	jmethodID mid;
+	jobject obj;
+	jint i;
+	cls = (*env)->FindClass(env, "Prog");
+    if (cls == NULL) {
+         return -1;
+    }
+    mid = (*env)->GetMethodID(env, cls, "<init>",
+                                     "()V");
+    if (mid == NULL){
+    	return -2;
+    }               
+    obj = (*env)->NewObject(env,cls,mid);
+    mid = (*env)->GetMethodID(env, cls, "getMethod",
+                                     "()I");
+    if (mid == NULL){
+    	return -3;
+    }           
+    i = (*env)-> CallIntMethod (env,obj,mid);
+   	return i;
+          
+}*/
+
+ src/Language/Java/JVM/hjvm.h view
@@ -0,0 +1,94 @@+#include <jni.h>
+
+#ifndef HJVM_H
+#define HJVM_H
+
+typedef void (*eventCallback)(JNIEnv *env, jobject listener,jint index,jobject event);
+
+/*struct runtime_  {
+	JavaVM *jvm;
+	JNIEnv *env;
+} ;*/
+
+//typedef struct runtime_ *runtime;
+
+jint start(char* classpath);
+void end();
+
+
+void freeClass(jclass global);
+void freeObject(jobject global);
+
+jclass findClass(const char *name);
+jmethodID findMethod(const jclass cls,const char *method,const char *signature);
+jmethodID findStaticMethod(const jclass cls,const char *method,const char *signature);
+jfieldID findField(const jclass cls,const char *name,const char *signature);
+jfieldID findStaticField(const jclass cls,const char *name,const char *signature);
+
+void registerCallback(const char *clsName,const char *methodName,const char *eventClsName,eventCallback f);
+jobject newObject(const jclass cls, const jmethodID method,const jvalue *args,jchar *error);
+jstring newString(const jchar *unicode, jsize len,jchar *error);
+
+jint callIntMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+void callVoidMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+jboolean callBooleanMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+jchar callCharMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+jshort callShortMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+jbyte callByteMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+jlong callLongMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+jdouble callDoubleMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+jfloat callFloatMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+jobject callObjectMethod(const jobject obj,const jmethodID method,const jvalue *args,jchar *error);
+
+jint callStaticIntMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+void callStaticVoidMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+jboolean callStaticBooleanMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+jchar callStaticCharMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+jshort callStaticShortMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+jbyte callStaticByteMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+jlong callStaticLongMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+jdouble callStaticDoubleMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+jfloat callStaticFloatMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+jobject callStaticObjectMethod(const jclass cls,const jmethodID method,const jvalue *args,jchar *error);
+
+jint getStaticIntField(const jclass cls,const jfieldID field,jchar *error);
+jboolean getStaticBooleanField(const jclass cls,const jfieldID field,jchar *error);
+jchar getStaticCharField(const jclass cls,const jfieldID field,jchar *error);
+jshort getStaticShortField(const jclass cls,const jfieldID field,jchar *error);
+jbyte getStaticByteField(const jclass cls,const jfieldID field,jchar *error);
+jlong getStaticLongField(const jclass cls,const jfieldID field,jchar *error);
+jdouble getStaticDoubleField(const jclass cls,const jfieldID field,jchar *error);
+jfloat getStaticFloatField(const jclass cls,const jfieldID field,jchar *error);
+jobject getStaticObjectField(const jclass cls,const jfieldID field,jchar *error);
+
+void setStaticIntField(const jclass cls,const jfieldID field,jint val,jchar *error);
+void setStaticBooleanField(const jclass cls,const jfieldID field,jboolean val,jchar *error);
+void setStaticCharField(const jclass cls,const jfieldID field,jchar val,jchar *error);
+void setStaticShortField(const jclass cls,const jfieldID field,jshort val,jchar *error);
+void setStaticByteField(const jclass cls,const jfieldID field,jbyte val,jchar *error);
+void setStaticLongField(const jclass cls,const jfieldID field,jlong val,jchar *error);
+void setStaticDoubleField(const jclass cls,const jfieldID field,jdouble val,jchar *error);
+void setStaticFloatField(const jclass cls,const jfieldID field,jfloat val,jchar *error);
+void setStaticObjectField(const jclass cls,const jfieldID field,jobject val,jchar *error);
+
+jint getIntField(const jobject obj,const jfieldID field,jchar *error);
+jboolean getBooleanField(const jobject obj,const jfieldID field,jchar *error);
+jchar getCharField(const jobject obj,const jfieldID field,jchar *error);
+jshort getShortField(const jobject obj,const jfieldID field,jchar *error);
+jbyte getByteField(const jobject obj,const jfieldID field,jchar *error);
+jlong getLongField(const jobject obj,const jfieldID field,jchar *error);
+jdouble getDoubleField(const jobject obj,const jfieldID field,jchar *error);
+jfloat getFloatField(const jobject obj,const jfieldID field,jchar *error);
+jobject getObjectField(const jobject obj,const jfieldID field,jchar *error);
+
+void setIntField(const jobject obj,const jfieldID field,jint val,jchar *error);
+void setBooleanField(const jobject obj,const jfieldID field,jboolean val,jchar *error);
+void setCharField(const jobject obj,const jfieldID field,jchar val,jchar *error);
+void setShortField(const jobject obj,const jfieldID field,jshort val,jchar *error);
+void setByteField(const jobject obj,const jfieldID field,jbyte val,jchar *error);
+void setLongField(const jobject obj,const jfieldID field,jlong val,jchar *error);
+void setDoubleField(const jobject obj,const jfieldID field,jdouble val,jchar *error);
+void setFloatField(const jobject obj,const jfieldID field,jfloat val,jchar *error);
+void setObjectField(const jobject obj,const jfieldID field,jobject val,jchar *error);
+
+#endif
+ src/libjvm.dll.a view

binary file changed (absent → 3782 bytes)

+ test/Language/Java/JVM/APITest.hs view
@@ -0,0 +1,226 @@+
+module Language.Java.JVM.APITest where
+
+
+import Language.Java.JVM.API
+import Language.Java.JVM.Types
+
+import Control.Monad.IO.Class
+import Foreign.Ptr
+
+import System.IO.Error
+import Test.HUnit
+
+apiTests::[Test]
+apiTests=[testStart,testClassNotFound,testMethodNotFound,testNewString,testIntMethod,testCharMethod,testByteMethod
+        ,testShortMethod,testLongMethod,testDoubleMethod,testFloatMethod,testBooleanMethod,testObjectMethod,testException
+        ,testStaticIntMethod,testStaticObjectMethod,testStaticIntField,testIntField,testInterfaceMethod
+        ,testEnd]
+
+testStart :: Test
+testStart=TestLabel "testStartEnd" (TestCase (do
+        withJava' False "" (do
+                liftIO $ assertBool "true" True
+                return ()
+                )
+        ))
+
+testEnd :: Test
+testEnd=TestLabel "testEnd" (TestCase (do
+        withJava' True "" (do
+                liftIO $ assertBool "true" True
+                return ()
+                )
+        ))  
+  
+testClassNotFound :: Test
+testClassNotFound  =TestLabel "testClassNotFound" (TestCase (do
+        ejo<-try $ withJava' False "" (newObject "java/lang/Integer2" "(I)V" [JInt 25])
+        case ejo of
+                Left _ ->return()
+                Right _->assertFailure "should be able to create Integer2"
+        el<-try $ withJava' False "" (do
+                withObject (newObject "java/lang/Integer" "(I)V" [JInt 25]) (\jo->
+                        byteMethod jo (Method "java/lang/Integer2" "byteValue" "()B") [])
+                )
+        case el of
+              Left _ ->return()
+              Right _->assertFailure "should be able to call byteValue on Integer2"
+        ))
+        
+testMethodNotFound :: Test
+testMethodNotFound  =TestLabel "testMethodNotFound" (TestCase (do
+        el<-try $ withJava' False "" (do
+                jo<-newObject "java/lang/Integer" "(I)V" [JInt 25]
+                byteMethod jo (Method "java/lang/Integer" "byteValue2" "()B") []
+                )
+        case el of
+              Left _ ->return()
+              Right _->assertFailure "should not be able to call byteValue2 on Integer"
+        ))
+        
+        
+testNewString :: Test       
+testNewString=TestLabel "testNewString" (TestCase (do
+        withJava' False "" (do
+                withObject (toJString "hello") (\jo->
+                        liftIO $ assertBool "jo"  (nullPtr/=jo))
+                return ())
+        ))
+        
+testIntMethod :: Test
+testIntMethod=TestLabel "testIntMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-toJString "hello"
+                l<-intMethod jo (Method "java/lang/String" "length" "()I") []
+                liftIO $ f_freeObject jo
+                liftIO $ assertEqual "jo" 5 l
+                return ())
+        ))
+
+testCharMethod :: Test
+testCharMethod=TestLabel "testCharMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-toJString "hello"
+                l<-charMethod jo  (Method "java/lang/String" "charAt" "(I)C") [JInt 0]
+                liftIO $ assertEqual "h" 'h' l
+                return ())
+        ))
+        
+testByteMethod :: Test        
+testByteMethod=TestLabel "testByteMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-newObject "java/lang/Integer" "(I)V" [JInt 25]
+                l<-byteMethod jo (Method "java/lang/Integer" "byteValue" "()B") []
+                liftIO $ assertEqual "25" 25 l
+                return ())
+        ))       
+ 
+testShortMethod :: Test      
+testShortMethod=TestLabel "testShortMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-newObject "java/lang/Integer" "(I)V" [JInt 25]
+                l<-shortMethod jo (Method "java/lang/Integer" "shortValue" "()S") []
+                liftIO $ assertEqual "25" 25 l
+                return ())
+        ))       
+     
+testLongMethod :: Test     
+testLongMethod=TestLabel "testLongMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-newObject "java/lang/Integer" "(I)V" [JInt 25]
+                l<-longMethod jo (Method "java/lang/Integer" "longValue" "()J") []
+                liftIO $ assertEqual "25" 25 l
+                return ())
+        ))       
+      
+testDoubleMethod :: Test      
+testDoubleMethod=TestLabel "testDoubleMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-newObject "java/lang/Double" "(D)V" [JDouble 25.67]
+                l<-doubleMethod jo (Method "java/lang/Double" "doubleValue" "()D") []
+                liftIO $ assertEqual "25.67" 25.67 l
+                return ())
+        ))          
+
+testFloatMethod :: Test
+testFloatMethod=TestLabel "testFloatMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-newObject "java/lang/Float" "(F)V" [JFloat 25.67]
+                l<-floatMethod jo (Method "java/lang/Float" "floatValue" "()F") []
+                liftIO $ assertEqual "25.67" 25.67 l
+                return ())
+        ))       
+ 
+testBooleanMethod :: Test        
+testBooleanMethod=TestLabel "testBooleanMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-toJString "hello"
+                l<-booleanMethod jo (Method "java/lang/String" "equals" "(Ljava/lang/Object;)Z") [JObj jo]
+                liftIO $ f_freeObject jo
+                liftIO $ assertBool "equals" l
+                return ())
+        ))
+ 
+testObjectMethod :: Test        
+testObjectMethod=TestLabel "testObjectMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-newObject "java/lang/Integer" "(I)V" [JInt 25]
+                s<-objectMethod jo (Method "java/lang/Object" "toString" "()Ljava/lang/String;") []
+                liftIO $ f_freeObject jo
+                freeClass "java/lang/Integer"
+                liftIO $ assertBool "toString" (nullPtr/=s)
+                liftIO $ f_freeObject s
+                return ())
+        ))     
+   
+   
+testStaticIntMethod :: Test
+testStaticIntMethod=TestLabel "testStaticIntMethod" (TestCase (do
+        withJava' False "" (do
+                jo<-toJString "5"
+                jc<-findClass "java/lang/Integer"
+                l<-staticIntMethod jc (Method "java/lang/Integer" "parseInt" "(Ljava/lang/String;)I") [JObj jo]
+                liftIO $ f_freeClass jc
+                liftIO $ f_freeObject jo
+                liftIO $ assertEqual "parseInt" 5 l
+                return ())
+        ))   
+   
+testStaticObjectMethod :: Test
+testStaticObjectMethod=TestLabel "testStaticObjectMethod" (TestCase (do
+        withJava' False "" (do
+                jc<-findClass "java/lang/Integer"
+                jo<-staticObjectMethod jc (Method "java/lang/Integer" "valueOf" "(I)Ljava/lang/Integer;") [JInt 5]
+                liftIO $ assertBool "testStaticObjectMethod" (nullPtr/=jo)
+                liftIO $ f_freeClass jc
+                liftIO $ f_freeObject jo
+                return ())
+        ))      
+   
+testStaticIntField   :: Test
+testStaticIntField=TestLabel "testStaticIntField" (TestCase (do
+        withJava' False "" (do
+                jc<-findClass "java/lang/Integer"
+                l<-getStaticIntField jc (Field "java/lang/Integer" "MAX_VALUE" "I")
+                liftIO $ assertBool "testStaticIntField" (l>0)
+                liftIO $ f_freeClass jc
+                return ())
+        ))      
+   
+testException :: Test        
+testException=TestLabel "testException" (TestCase (do
+        el<-try $ withJava' False "" (do
+                s<-toJString "aa"
+                newObject "java/lang/Integer" "(Ljava/lang/String;)V" [JObj s]
+                )
+        case el of
+              Left _ ->return()
+              Right _->assertFailure "should be not able to call new Integer with aa"
+        ))   
+        
+testIntField :: Test
+testIntField=TestLabel "testIntField" (TestCase (do
+        withJava' False "" (do
+                pt<-newObject "java/awt/Point" "()V" []
+                let fx=Field "java/awt/Point" "x" "I"
+                x1<-getIntField pt fx
+                liftIO $ assertEqual "x1 is not 0" 0 x1
+                setIntField pt fx 100
+                x2<-getIntField pt fx
+                liftIO $ assertEqual "x2 is not 100" 100 x2
+                return ())
+        ))
+        
+testInterfaceMethod :: Test
+testInterfaceMethod=TestLabel "testInterfaceMethod" (TestCase (do
+        withJava' False "" (do
+                jc<-findClass "java/text/NumberFormat"
+                jo<-staticObjectMethod jc (Method "java/text/NumberFormat" "getInstance" "()Ljava/text/NumberFormat;") []
+                s<-objectMethod jo (Method "java/text/NumberFormat" "format" "(D)Ljava/lang/String;") [JDouble 5.3]
+                liftIO $ assertBool "format" (nullPtr/=s)
+                liftIO $ f_freeObject s
+                liftIO $ f_freeObject jo
+                liftIO $ f_freeClass jc
+                )
+        ))
+ test/Language/Java/JVM/GeneratorTest.hs view
@@ -0,0 +1,19 @@+
+module Language.Java.JVM.GeneratorTest where
+
+import Language.Java.JVM.Generator
+import Language.Java.JVM.JavapParserTest (parse)
+import Language.Haskell.Exts.Pretty
+
+import Test.HUnit
+
+generatorTests :: [Test]
+generatorTests = [testObject]
+
+testObject :: Test
+testObject=TestLabel "testObject" (TestCase (do
+        Just td<-parse "java/lang/Object"
+        let (mod,fp)=generate td
+        putStrLn $ prettyPrint mod
+        -- writeFile ("../HJVMBindings/src/Language/Java/JVM/Bindings/"++fp) (prettyPrint mod)
+        ))
+ test/Language/Java/JVM/JavapParserTest.hs view
@@ -0,0 +1,45 @@+
+module Language.Java.JVM.JavapParserTest where
+
+import Language.Java.JVM.JavapParser
+import Language.Java.JVM.Generator
+
+import System.Environment
+
+import Test.HUnit
+
+javapParserTests::[Test]
+javapParserTests=[testObject,testString]
+
+parse :: String -> IO (Maybe TypeDecl)
+parse cls=do
+        javaHome<-getEnv "JAVA_HOME"
+        ep<-parseClass javaHome cls
+        case ep of
+                Left err->do
+                        assertFailure $ show err
+                        return Nothing
+                Right td->return $ Just td
+
+testObject :: Test
+testObject=TestLabel "testObject" (TestCase (do
+        Just td<-parse "java/lang/Object"
+        assertEqual "Object has supers!" 0 (length $ td_supers td)
+        assertBool "Object has no decls!" (0<(length $ td_decls td))
+        let toString=JMethodDecl "toString" "()Ljava/lang/String;" False -- simple method
+        assertBool "Doesn't contain toString" (elem toString $ td_decls td)
+        let cons=JMethodDecl "<init>" "()V" False
+        assertBool "Doesn't contain constructor" (elem cons $ td_decls td) -- constructor
+        let wait=JMethodDecl "wait" "(J)V" False
+        assertBool "Doesn't contain wait" (elem wait $ td_decls td) -- throws
+        ))
+ 
+testString :: Test       
+testString=TestLabel "testString" (TestCase (do
+        Just td<-parse "java/lang/String"
+        assertEqual "String supers" ["java/lang/Object","java/io/Serializable","java/lang/Comparable","java/lang/CharSequence"] (td_supers td)
+        let comp=JFieldDecl "CASE_INSENSITIVE_ORDER" "Ljava/util/Comparator;" True -- static field
+        assertBool "Doesn't contain CASE_INSENSITIVE_ORDER" (elem comp $ td_decls td)
+        let cons=JMethodDecl "<init>" "([C)V" False
+        assertBool "Doesn't contain constructor" (elem cons $ td_decls td) -- constructor with array parameter
+        ))
+ test/Language/Java/JVM/SignatureParserTest.hs view
@@ -0,0 +1,26 @@+
+module Language.Java.JVM.SignatureParserTest where
+
+import Language.Java.JVM.SignatureParser
+
+import Test.HUnit
+
+parse :: String -> IO (Maybe JSignature)
+parse sig=do
+        let ep=parseSignature sig
+        case ep of
+                Left err->do
+                        assertFailure $ show err
+                        return Nothing
+                Right td->return $ Just td
+
+signatureParserTests :: Test
+signatureParserTests = TestLabel "signatureParserTests" (TestCase (do
+        Just j0<-parse "()V"
+        assertEqual "noargs, no ret" (JSignature [] Nothing) j0
+        Just j1<-parse "(Ljava/lang/Object;)I"
+        assertEqual "noargs, no ret" (JSignature ["JObj"] (Just "JInt")) j1
+        Just j2<-parse "([CII)Ljava/lang/String;"
+        assertEqual "noargs, no ret" (JSignature ["JObj","JInt","JInt"] (Just "JObj")) j2
+        ))
+
+ test/Main.hs view
@@ -0,0 +1,34 @@+
+module Main where
+
+import Language.Java.JVM.APITest
+import Language.Java.JVM.GeneratorTest
+import Language.Java.JVM.JavapParserTest
+import Language.Java.JVM.SignatureParserTest
+
+--import Control.Monad
+--import System.Exit (exitFailure)
+
+import Test.Framework (defaultMain, testGroup,Test)
+import Test.Framework.Providers.HUnit
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: [Test]
+tests = [testGroup "API Tests" (concatMap (hUnitTestToTests) apiTests),
+        testGroup "JavaP Parser Tests" (concatMap (hUnitTestToTests) javapParserTests),
+        testGroup "Signature Parser Tests" (concatMap (hUnitTestToTests) [signatureParserTests]),
+        testGroup "Generator Tests" (concatMap (hUnitTestToTests) generatorTests)]
+
+--main :: IO()
+--main = do
+--    runHUnitTest apiTests
+--    runHUnitTest javapParserTests
+--    runHUnitTest signatureParserTests
+--    runHUnitTest generatorTests
+--    
+--runHUnitTest :: Test -> IO ()
+--runHUnitTest t=  do
+--        counts1<-runTestTT t
+--        when ((errors counts1)>0 || (failures counts1)>0) exitFailure