diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright EURL Tweag (c) 2015-2016 + +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 the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT +OWNER OR 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,36 @@ +# jvm: Call any JVM function from Haskell + +This package enables calling any JVM function from Haskell. If you'd +like to call JVM methods using Java syntax and hence get the Java +compiler to scope check and type check all your foreign calls, see +[inline-java][inline-java], which builds on top of this package. + +[inline-java]: https://github.com/tweag/inline-java#readme + +# Example + +Graphical Hello World using Java Swing: + +```Haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +import Data.Text (Text) +import Language.Java + +newtype JOptionPane = JOptionPane (J ('Class "javax.swing.JOptionPane")) +instance Coercible JOptionPane ('Class "javax.swing.JOptionPane") + +main :: IO () +main = withJVM [] $ do + message <- reflect ("Hello World!" :: Text) + callStatic + (classOf (undefined :: JOptionPane)) + "showMessageDialog" + [JObject nullComponent, JObject (upcast message)] + where + nullComponent :: J ('Class "java.awt.Component") + nullComponent = jnull +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/jvm.cabal b/jvm.cabal new file mode 100644 --- /dev/null +++ b/jvm.cabal @@ -0,0 +1,50 @@ +name: jvm +version: 0.1 +synopsis: Call JVM methods from Haskell. +description: Please see README.md. +homepage: http://github.com/tweag/inline-java/tree/master/jvm#readme +license: BSD3 +license-file: LICENSE +author: Tweag I/O +maintainer: m@tweag.io +copyright: 2015-2016 EURL Tweag. +category: FFI, JVM, Java +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +source-repository head + type: git + location: https://github.com/tweag/inline-java + subdir: jvm + +library + hs-source-dirs: src + exposed-modules: + Language.Java + build-depends: + base >= 4.7 && < 5, + bytestring >=0.10, + distributed-closure >=0.3, + jni >= 0.1, + singletons >= 2.0, + text >=1.2, + vector >=0.11 + default-language: Haskell2010 + +test-suite spec + type: + exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Main.hs + other-modules: + Language.JavaSpec + Spec + build-depends: + base, + bytestring, + hspec, + jvm, + text + default-language: Haskell2010 + extra-libraries: pthread diff --git a/src/Language/Java.hs b/src/Language/Java.hs new file mode 100644 --- /dev/null +++ b/src/Language/Java.hs @@ -0,0 +1,478 @@ +-- | High-level helper functions for interacting with Java objects, mapping them +-- to Haskell values and vice versa. The 'Reify' and 'Reflect' classes together +-- are to Java what "Foreign.Storable" is to C: they provide a means to +-- marshall/unmarshall Java objects from/to Haskell data types. +-- +-- A typical pattern for wrapping Java API's using this module is: +-- +-- @ +-- {-\# LANGUAGE DataKinds \#-} +-- module Object where +-- +-- import Language.Java as J +-- +-- newtype Object = Object ('J' (''Class' "java.lang.Object")) +-- instance 'Coercible' Object +-- +-- clone :: Object -> IO Object +-- clone obj = J.'call' obj "clone" [] +-- +-- equals :: Object -> Object -> IO Bool +-- equals obj1 obj2 = J.'call' obj1 "equals" ['jvalue' obj2] +-- +-- ... +-- @ +-- +-- To call Java methods using quasiquoted Java syntax instead, see +-- "Language.Java.Inline". +-- +-- __NOTE:__ To use any function in this module, you'll need an initialized JVM in the +-- current process, using 'withJVM' or otherwise. + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} + +module Language.Java + ( module Foreign.JNI.Types + , withJVM + , classOf + , new + , call + , callStatic + , jvalue + , Coercible(..) + , Reify(..) + , Reflect(..) + , Type(..) + , Uncurry + , Interp + , sing + ) where + +import Control.Distributed.Closure +import Control.Distributed.Closure.TH +import Control.Monad ((<=<), forM, forM_) +import Data.Char (chr, ord) +import qualified Data.Coerce as Coerce +import Data.Int +import Data.Word +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Unsafe as BS +import Data.Singletons (SingI(..), fromSing) +import Data.String (fromString) +import qualified Data.Text.Foreign as Text +import Data.Text (Text) +import qualified Data.Vector.Storable as Vector +import Data.Vector.Storable (Vector) +import qualified Data.Vector.Storable.Mutable as MVector +import Data.Vector.Storable.Mutable (IOVector) +import Foreign (FunPtr, Ptr, Storable, newForeignPtr, withForeignPtr) +import Foreign.C (CChar) +import Foreign.JNI +import Foreign.JNI.Types +import qualified Foreign.JNI.String as JNI +import GHC.TypeLits (KnownSymbol, Symbol) + +-- | Tag data types that can be coerced in O(1) time without copy to a Java +-- object or primitive type (i.e. have the same representation) by declaring an +-- instance of this type class for that data type. +class SingI ty => Coercible a (ty :: JType) | a -> ty where + coerce :: a -> JValue + unsafeUncoerce :: JValue -> a + + default coerce + :: Coerce.Coercible a (J ty) + => a + -> JValue + coerce x = JObject (Coerce.coerce x :: J ty) + + default unsafeUncoerce + :: Coerce.Coercible (J ty) a + => JValue + -> a + unsafeUncoerce (JObject obj) = Coerce.coerce (unsafeCast obj :: J ty) + unsafeUncoerce _ = + error "Cannot unsafeUncoerce: object expected but value of primitive type found." + +-- | The identity instance. +instance SingI ty => Coercible (J ty) ty + +instance Coercible Bool ('Prim "boolean") where + coerce x = JBoolean (fromIntegral (fromEnum x)) + unsafeUncoerce (JBoolean x) = toEnum (fromIntegral x) + unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." +instance Coercible CChar ('Prim "byte") where + coerce = JByte + unsafeUncoerce (JByte x) = x + unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." +instance Coercible Char ('Prim "char") where + coerce x = JChar (fromIntegral (ord x)) + unsafeUncoerce (JChar x) = chr (fromIntegral x) + unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." +instance Coercible Word16 ('Prim "char") where + coerce = JChar + unsafeUncoerce (JChar x) = x + unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." +instance Coercible Int16 ('Prim "short") where + coerce = JShort + unsafeUncoerce (JShort x) = x + unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." +instance Coercible Int32 ('Prim "int") where + coerce = JInt + unsafeUncoerce (JInt x) = x + unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." +instance Coercible Int64 ('Prim "long") where + coerce = JLong + unsafeUncoerce (JLong x) = x + unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." +instance Coercible Float ('Prim "float") where + coerce = JFloat + unsafeUncoerce (JFloat x) = x + unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." +instance Coercible Double ('Prim "double") where + coerce = JDouble + unsafeUncoerce (JDouble x) = x + unsafeUncoerce _ = error "unsafeUncoerce: value doesn't match target type." +instance Coercible () 'Void where + coerce = error "Void value undefined." + unsafeUncoerce _ = () + +-- | Get the Java class of an object or anything 'Coercible' to one. +classOf + :: ( Coerce.Coercible a (J ('Class sym)) + , Coercible a ('Class sym) + , KnownSymbol sym + ) + => a + -> Sing sym +classOf _ = sing + +-- | Creates a new instance of the class whose name is resolved from the return +-- type. For instance, +-- +-- @ +-- do x :: 'J' (''Class' "java.lang.Integer") <- new ['coerce' 42] +-- return x +-- @ +new + :: forall a sym. + ( Coerce.Coercible a (J ('Class sym)) + , Coercible a ('Class sym) + , KnownSymbol sym + ) + => [JValue] + -> IO a +new args = do + let argsings = map jtypeOf args + voidsing = sing :: Sing 'Void + klass <- findClass (referenceTypeName (sing :: Sing ('Class sym))) + Coerce.coerce <$> newObject klass (methodSignature argsings voidsing) args + +-- | The Swiss Army knife for calling Java methods. Give it an object or +-- any data type coercible to one, the name of a method, and a list of +-- arguments. Based on the type indexes of each argument, and based on the +-- return type, 'call' will invoke the named method using of the @call*Method@ +-- family of functions in the JNI API. +-- +-- When the method name is overloaded, use 'upcast' or 'unsafeCast' +-- appropriately on the class instance and/or on the arguments to invoke the +-- right method. +call + :: forall a b ty1 ty2. (IsReferenceType ty1, Coercible a ty1, Coercible b ty2, Coerce.Coercible a (J ty1)) + => a -- ^ Any object or value 'Coercible' to one + -> JNI.String -- ^ Method name + -> [JValue] -- ^ Arguments + -> IO b +call obj mname args = do + let argsings = map jtypeOf args + retsing = sing :: Sing ty2 + klass <- findClass (referenceTypeName (sing :: Sing ty1)) + method <- getMethodID klass mname (methodSignature argsings retsing) + case retsing of + SPrim "boolean" -> unsafeUncoerce . coerce <$> callBooleanMethod obj method args + SPrim "byte" -> unsafeUncoerce . coerce <$> callByteMethod obj method args + SPrim "char" -> unsafeUncoerce . coerce <$> callCharMethod obj method args + SPrim "short" -> unsafeUncoerce . coerce <$> callShortMethod obj method args + SPrim "int" -> unsafeUncoerce . coerce <$> callIntMethod obj method args + SPrim "long" -> unsafeUncoerce . coerce <$> callLongMethod obj method args + SPrim "float" -> unsafeUncoerce . coerce <$> callFloatMethod obj method args + SPrim "double" -> unsafeUncoerce . coerce <$> callDoubleMethod obj method args + SVoid -> do + callVoidMethod obj method args + -- Anything uncoerces to the void type. + return (unsafeUncoerce undefined) + _ -> unsafeUncoerce . coerce <$> callObjectMethod obj method args + +-- | Same as 'call', but for static methods. +callStatic :: forall a ty sym. Coercible a ty => Sing (sym :: Symbol) -> JNI.String -> [JValue] -> IO a +callStatic cname mname args = do + let argsings = map jtypeOf args + retsing = sing :: Sing ty + klass <- findClass (referenceTypeName (SClass (fromString (fromSing cname)))) + method <- getStaticMethodID klass mname (methodSignature argsings retsing) + case retsing of + SPrim "boolean" -> unsafeUncoerce . coerce <$> callStaticBooleanMethod klass method args + SPrim "byte" -> unsafeUncoerce . coerce <$> callStaticByteMethod klass method args + SPrim "char" -> unsafeUncoerce . coerce <$> callStaticCharMethod klass method args + SPrim "short" -> unsafeUncoerce . coerce <$> callStaticShortMethod klass method args + SPrim "int" -> unsafeUncoerce . coerce <$> callStaticIntMethod klass method args + SPrim "long" -> unsafeUncoerce . coerce <$> callStaticLongMethod klass method args + SPrim "float" -> unsafeUncoerce . coerce <$> callStaticFloatMethod klass method args + SPrim "double" -> unsafeUncoerce . coerce <$> callStaticDoubleMethod klass method args + SVoid -> do + callStaticVoidMethod klass method args + -- Anything uncoerces to the void type. + return (unsafeUncoerce undefined) + _ -> unsafeUncoerce . coerce <$> callStaticObjectMethod klass method args + +-- | Inject a value (of primitive or reference type) to a 'JValue'. This +-- datatype is useful for e.g. passing arguments as a list of homogeneous type. +-- Synonym for 'coerce'. +jvalue :: Coercible a ty => a -> JValue +jvalue = coerce + +-- | Classifies Java types according to whether they are base types (data) or +-- higher-order types (objects representing functions). +data Type a + = Fun [Type a] (Type a) -- ^ Pure function + | Act [Type a] (Type a) -- ^ IO action + | Proc [Type a] -- ^ Procedure (i.e void returning action) + | Base a -- ^ Any first-order type. + +-- | Haskell functions are curried, but Java functions are not. This type family +-- maps Haskell types to an uncurried (non-inductive) type representation, +-- useful to select the right 'Reify' / 'Reflect' instance without overlap. +type family Uncurry (a :: *) :: Type * where + Uncurry (Closure (a -> b -> c -> d -> IO ())) = 'Proc '[Uncurry a, Uncurry b, Uncurry c, Uncurry d] + Uncurry (Closure (a -> b -> c -> IO ())) = 'Proc '[Uncurry a, Uncurry b, Uncurry c] + Uncurry (Closure (a -> b -> IO ())) = 'Proc '[Uncurry a, Uncurry b] + Uncurry (Closure (a -> IO ())) = 'Proc '[Uncurry a] + Uncurry (IO ()) = 'Proc '[] + Uncurry (Closure (a -> b -> c -> d -> IO e)) = 'Act '[Uncurry a, Uncurry b, Uncurry c, Uncurry d] (Uncurry e) + Uncurry (Closure (a -> b -> c -> IO d)) = 'Act '[Uncurry a, Uncurry b, Uncurry c] (Uncurry d) + Uncurry (Closure (a -> b -> IO c)) = 'Act '[Uncurry a, Uncurry b] (Uncurry c) + Uncurry (Closure (a -> IO b)) = 'Act '[Uncurry a] (Uncurry b) + Uncurry (Closure (IO a)) = 'Act '[] (Uncurry a) + Uncurry (Closure (a -> b -> c -> d -> e)) = 'Fun '[Uncurry a, Uncurry b, Uncurry c, Uncurry d] (Uncurry e) + Uncurry (Closure (a -> b -> c -> d)) = 'Fun '[Uncurry a, Uncurry b, Uncurry c] (Uncurry d) + Uncurry (Closure (a -> b -> c)) = 'Fun '[Uncurry a, Uncurry b] (Uncurry c) + Uncurry (Closure (a -> b)) = 'Fun '[Uncurry a] (Uncurry b) + Uncurry a = 'Base a + +-- | Map a Haskell type to the symbolic representation of a Java type. +type family Interp (a :: k) :: JType +type instance Interp ('Base a) = Interp a + +-- | Extract a concrete Haskell value from the space of Java objects. That is to +-- say, unmarshall a Java object to a Haskell value. Unlike coercing, in general +-- reifying induces allocations and copies. +class (Interp (Uncurry a) ~ ty, SingI ty) => Reify a ty where + reify :: J ty -> IO a + +-- | Inject a concrete Haskell value into the space of Java objects. That is to +-- say, marshall a Haskell value to a Java object. Unlike coercing, in general +-- reflection induces allocations and copies. +class (Interp (Uncurry a) ~ ty, SingI ty) => Reflect a ty where + reflect :: a -> IO (J ty) + +foreign import ccall "wrapper" wrapFinalizer + :: (Ptr a -> IO ()) + -> IO (FunPtr (Ptr a -> IO ())) + +reifyMVector + :: Storable a + => (JArray ty -> IO (Ptr a)) + -> (JArray ty -> Ptr a -> IO ()) + -> JArray ty + -> IO (IOVector a) +reifyMVector mk finalize jobj = do + n <- getArrayLength jobj + ptr <- mk jobj + ffinalize <- wrapFinalizer (finalize jobj) + fptr <- newForeignPtr ffinalize ptr + return (MVector.unsafeFromForeignPtr0 fptr (fromIntegral n)) + +reflectMVector + :: Storable a + => (Int32 -> IO (JArray ty)) + -> (JArray ty -> Int32 -> Int32 -> Ptr a -> IO ()) + -> IOVector a + -> IO (JArray ty) +reflectMVector newfun fill mv = do + let (fptr, n) = MVector.unsafeToForeignPtr0 mv + jobj <- newfun (fromIntegral n) + withForeignPtr fptr $ fill jobj 0 (fromIntegral n) + return jobj + +withStatic [d| + type instance Interp (J ty) = ty + + instance SingI ty => Reify (J ty) ty where + reify x = return x + + instance SingI ty => Reflect (J ty) ty where + reflect x = return x + + type instance Interp () = 'Class "java.lang.Object" + + instance Reify () ('Class "java.lang.Object") where + reify _ = return () + + instance Reflect () ('Class "java.lang.Object") where + reflect () = new [] + + type instance Interp ByteString = 'Array ('Prim "byte") + + instance Reify ByteString ('Array ('Prim "byte")) where + reify jobj = do + n <- getArrayLength (unsafeCast jobj) + bytes <- getByteArrayElements jobj + -- TODO could use unsafePackCStringLen instead and avoid a copy if we knew + -- that been handed an (immutable) copy via JNI isCopy ref. + bs <- BS.packCStringLen (bytes, fromIntegral n) + releaseByteArrayElements jobj bytes + return bs + + instance Reflect ByteString ('Array ('Prim "byte")) where + reflect bs = BS.unsafeUseAsCStringLen bs $ \(content, n) -> do + arr <- newByteArray (fromIntegral n) + setByteArrayRegion arr 0 (fromIntegral n) content + return arr + + type instance Interp Bool = 'Class "java.lang.Boolean" + + instance Reify Bool ('Class "java.lang.Boolean") where + reify jobj = do + klass <- findClass "java/lang/Boolean" + method <- getMethodID klass "booleanValue" "()Z" + callBooleanMethod jobj method [] + + instance Reflect Bool ('Class "java.lang.Boolean") where + reflect x = new [JBoolean (fromIntegral (fromEnum x))] + + type instance Interp Int16 = 'Class "java.lang.Short" + + instance Reify Int16 ('Class "java.lang.Short") where + reify jobj = do + klass <- findClass "java/lang/Short" + method <- getMethodID klass "shortValue" "()S" + callShortMethod jobj method [] + + instance Reflect Int16 ('Class "java.lang.Short") where + reflect x = new [JShort x] + + type instance Interp Int32 = 'Class "java.lang.Integer" + + instance Reify Int32 ('Class "java.lang.Integer") where + reify jobj = do + klass <- findClass "java/lang/Integer" + method <- getMethodID klass "intValue" "()I" + callIntMethod jobj method [] + + instance Reflect Int32 ('Class "java.lang.Integer") where + reflect x = new [JInt x] + + type instance Interp Int64 = 'Class "java.lang.Long" + + instance Reify Int64 ('Class "java.lang.Long") where + reify jobj = do + klass <- findClass "java/lang/Long" + method <- getMethodID klass "longValue" "()J" + callLongMethod jobj method [] + + instance Reflect Int64 ('Class "java.lang.Long") where + reflect x = new [JLong x] + + type instance Interp Word16 = 'Class "java.lang.Character" + + instance Reify Word16 ('Class "java.lang.Character") where + reify jobj = do + klass <- findClass "java/lang/Character" + method <- getMethodID klass "charValue" "()C" + fromIntegral <$> callCharMethod jobj method [] + + instance Reflect Word16 ('Class "java.lang.Character") where + reflect x = new [JChar x] + + type instance Interp Double = 'Class "java.lang.Double" + + instance Reify Double ('Class "java.lang.Double") where + reify jobj = do + klass <- findClass "java/lang/Double" + method <- getMethodID klass "doubleValue" "()D" + callDoubleMethod jobj method [] + + instance Reflect Double ('Class "java.lang.Double") where + reflect x = new [JDouble x] + + type instance Interp Float = 'Class "java.lang.Float" + + instance Reify Float ('Class "java.lang.Float") where + reify jobj = do + klass <- findClass "java/lang/Float" + method <- getMethodID klass "floatValue" "()F" + callFloatMethod jobj method [] + + instance Reflect Float ('Class "java.lang.Float") where + reflect x = new [JFloat x] + + type instance Interp Text = 'Class "java.lang.String" + + instance Reify Text ('Class "java.lang.String") where + reify jobj = do + sz <- getStringLength jobj + cs <- getStringChars jobj + txt <- Text.fromPtr cs (fromIntegral sz) + releaseStringChars jobj cs + return txt + + instance Reflect Text ('Class "java.lang.String") where + reflect x = + Text.useAsPtr x $ \ptr len -> + newString ptr (fromIntegral len) + + type instance Interp (IOVector Int32) = 'Array ('Prim "int") + + instance Reify (IOVector Int32) ('Array ('Prim "int")) where + reify = reifyMVector (getIntArrayElements) (releaseIntArrayElements) + + instance Reflect (IOVector Int32) ('Array ('Prim "int")) where + reflect = reflectMVector (newIntArray) (setIntArrayRegion) + + type instance Interp (Vector Int32) = 'Array ('Prim "int") + + instance Reify (Vector Int32) ('Array ('Prim "int")) where + reify = Vector.freeze <=< reify + + instance Reflect (Vector Int32) ('Array ('Prim "int")) where + reflect = reflect <=< Vector.thaw + + type instance Interp [a] = 'Array (Interp (Uncurry a)) + + instance Reify a ty => Reify [a] ('Array ty) where + reify jobj = do + n <- getArrayLength jobj + forM [0..n-1] $ \i -> do + x <- getObjectArrayElement jobj i + reify x + + instance Reflect a ty => Reflect [a] ('Array ty) where + reflect xs = do + let n = fromIntegral (length xs) + klass <- findClass "java/lang/Object" + array <- newObjectArray n klass + forM_ (zip [0..n-1] xs) $ \(i, x) -> do + setObjectArrayElement array i =<< reflect x + return (unsafeCast array) + |] diff --git a/tests/Language/JavaSpec.hs b/tests/Language/JavaSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Language/JavaSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} + +module Language.JavaSpec where + +import Data.Int +import qualified Data.Text as Text +import Data.Text (Text) +import Language.Java +import Test.Hspec + +spec :: Spec +spec = do + describe "callStatic" $ do + it "can call double-returning static functions" $ do + jstr <- reflect ("1.2345" :: Text) + callStatic (sing :: Sing "java.lang.Double") "parseDouble" [coerce jstr] + `shouldReturn` (1.2345 :: Double) + + it "can call int-returning static functions" $ do + jstr <- reflect ("12345" :: Text) + callStatic (sing :: Sing "java.lang.Integer") "parseInt" [coerce jstr] + `shouldReturn` (12345 :: Int32) + + it "can call String-returning static functions" $ do + jstr <- + callStatic + (sing :: Sing "java.lang.Integer") + "toString" + [coerce (12345 :: Int32)] + reify jstr `shouldReturn` ("12345" :: Text) + + it "short doesn't under- or overflow" $ do + maxshort <- reflect (Text.pack (show (maxBound :: Int16))) + minshort <- reflect (Text.pack (show (minBound :: Int16))) + callStatic (sing :: Sing "java.lang.Short") "parseShort" [coerce maxshort] + `shouldReturn` (maxBound :: Int16) + callStatic (sing :: Sing "java.lang.Short") "parseShort" [coerce minshort] + `shouldReturn` (minBound :: Int16) + + it "int doesn't under- or overflow" $ do + maxint <- reflect (Text.pack (show (maxBound :: Int32))) + minint <- reflect (Text.pack (show (minBound :: Int32))) + callStatic (sing :: Sing "java.lang.Integer") "parseInt" [coerce maxint] + `shouldReturn` (maxBound :: Int32) + callStatic (sing :: Sing "java.lang.Integer") "parseInt" [coerce minint] + `shouldReturn` (minBound :: Int32) + + it "long doesn't under- or overflow" $ do + maxlong <- reflect (Text.pack (show (maxBound :: Int64))) + minlong <- reflect (Text.pack (show (minBound :: Int64))) + callStatic (sing :: Sing "java.lang.Long") "parseLong" [coerce maxlong] + `shouldReturn` (maxBound :: Int64) + callStatic (sing :: Sing "java.lang.Long") "parseLong" [coerce minlong] + `shouldReturn` (minBound :: Int64) diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import Language.Java (withJVM) +import qualified Spec +import Test.Hspec + +main :: IO () +main = withJVM [] $ hspec Spec.spec diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}