{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} -- Test that inline-java produces code without warnings or errors. {-# OPTIONS_GHC -dcore-lint -Wall -Werror #-} module Language.Java.InlineSpec(spec) where import Data.Char import Data.Int import qualified Data.Text as Text import qualified Data.Vector.Storable as Vector import Data.Vector.Storable.Mutable (IOVector) import Foreign.JNI (JVMException) import Language.Java import Language.Java.Inline import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck import Test.QuickCheck.Unicode type ObjectClass = 'Class "java.lang.Object" type ListClass = 'Iface "java.util.List" type JJObject = JObject type List a = J (ListClass <> '[a]) imports "java.util.*" spec :: Spec spec = do describe "Java quasiquoter" $ do it "Can return ()" $ do [java| { } |] :: IO () it "Evaluates simple expressions" $ do [java| 1 + 1 |] `shouldReturn` (2 :: Int32) it "Evaluates simple blocks" $ do [java| { int x = 1; int y = 2; return x + y; } |] `shouldReturn` (3 :: Int32) it "Supports antiquotation variables" $ do let x = 1 :: Int32 [java| $x + 1 |] `shouldReturn` (2 :: Int32) describe "Type synonyms" $ do it "Supports top-level type synonym'ed antiquotation variables" $ do obj <- [java| new Object() {} |] let obj1 = obj :: JObject _ :: JObject <- [java| $obj1 |] return () it "Supports inner type synonym'ed antiquotation variables" $ do obj <- [java| new Object() {} |] let obj1 = obj :: J ObjectClass _ :: J ObjectClass <- [java| $obj1 |] return () it "Supports chained type synonym'ed antiquotation variables" $ do obj <- [java| new Object() {} |] let obj1 = obj :: JJObject _ :: JJObject <- [java| $obj1 |] return () it "Supports parameterized type synonyms" $ do obj :: List ObjectClass <- [java| new ArrayList() |] _ :: List ObjectClass <- [java| $obj |] return () it "Supports multiple antiquotation variables" $ do let foo = 1 :: Int32 bar = 2 :: Int32 [java| $foo + $bar |] `shouldReturn` (3 :: Int32) it "Supports repeated antiquotation variables" $ do obj :: JObject <- [java| new Object() {} |] ([java| $obj.equals($obj) |] >>= reify) `shouldReturn` True it "Supports antiquotation variables in blocks" $ do let z = 1 :: Int32 [java| { return $z + 1; } |] `shouldReturn` (2 :: Int32) it "Supports anonymous classes" $ do _ :: JObject <- [java| new Object() {} |] return () it "Supports multiple anonymous classes" $ do [java| new Object() {}.equals(new Object() {}) |] `shouldReturn` False it "Supports using antiquotation variables in inner classes" $ do let foo = 1 :: Int32 [java| { class Foo { int f() { return $foo; } }; } |] :: IO () it "Supports import declarations" $ do -- Arrays comes from the java.util package. _ <- [java| Arrays.asList().toArray() |] :: IO JObjectArray return () it "Supports anonymous functions" $ do [java| { List xs = Arrays.asList(1, 2); Collections.sort(xs, (a, b) -> b.compareTo(a)); return xs.get(0); } |] `shouldReturn` (2 :: Int32) it "Can be used inside brackets" $ do $([| let _x = 1 :: Int32 -- Named _x to avoid spurious "unused" warning in (+1) <$> [java| $_x |] |]) `shouldReturn` (2 :: Int32) it "Can throw checked exceptions" $ do ([java| { throw new InterruptedException(); } |] :: IO ()) `shouldThrow` \(_ :: JVMException) -> True it "Type-checks generics" $ do obj :: List ('Class "java.lang.String") <- [java| new ArrayList() |] _ :: List ('Class "java.lang.String") <- [java| $obj |] return () it "Can access inner classes" $ do st :: J ('Class "java.lang.Thread$State") <- [java| Thread.State.NEW |] [java| $st == Thread.State.NEW |] `shouldReturn` True it "Supports modified utf-8 encoding from Haskell to Java" $ withLocalRef (reflect ("a\NULb" :: Text.Text)) $ \jString -> [java| "a\0b".equals($jString) |] `shouldReturn` True it "Supports modified utf-8 encoding from Java to Haskell" $ do withLocalRef [java| "a\0b" |] reify `shouldReturn` ("a\NULb" :: Text.Text) prop "Processes Unicode code points as the JVM does" $ do \u -> ioProperty $ do let chars :: [Char] = fromUnicode u let text = Text.pack chars codePoints :: IOVector Int32 <- Vector.thaw $ Vector.fromList $ map (fromIntegral . ord) chars withLocalRef (reflect codePoints) $ \jPoints -> do jString <- [java| new String($jPoints, 0, $jPoints.length) |] jText <- reify jString return $ jText === text